New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2007 – NEMO

Changeset 2007


Ignore:
Timestamp:
2010-07-13T17:14:39+02:00 (14 years ago)
Author:
smasson
Message:

update branches/DEV_r1879_FCM/NEMOGCM/NEMO with tags/nemo_v3_2_1/NEMO

Location:
branches/DEV_r1879_FCM/NEMOGCM/NEMO
Files:
85 edited
5 copied

Legend:

Unmodified
Added
Removed

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90

    r1694 r2007  
    6666      ENDIF 
    6767       
     68      IF( jphgr_msh == 2 .OR. jphgr_msh == 3 .OR. jphgr_msh == 5 )   & 
     69          &      CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane' ) 
     70 
    6871      !----------------------------------------------------------                           
    6972      !    Initialization of local and some global (common) variables  

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r1756 r2007  
    8080      INTEGER  ::   ifvt, i1mfr, idfr               ! some switches 
    8181      INTEGER  ::   iflt, ial, iadv, ifral, ifrdv 
    82       INTEGER  ::   ii0, ii1, ij0, ij1  ! temporary integers 
    8382      REAL(wp) ::   zrdtir           ! 1. / rdt_ice 
    8483      REAL(wp) ::   zqsr  , zqns     ! solar & non solar heat flux 
    … …  
    109108         sice_r(:,:) = sice 
    110109         ! 
    111          IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
    112             !                                        ! ======================= 
    113             !                                        !  ORCA_R2 configuration 
    114             !                                        ! ======================= 
    115             ii0 = 145   ;   ii1 = 180        ! Baltic Sea 
    116             ij0 = 113   ;   ij1 = 130   ;   soce_r(mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 
    117                                             sice_r(mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 2.e0 
    118          ENDIF 
    119          ! 
    120       ENDIF 
     110         IF( cp_cfg == "orca" ) THEN 
     111           !   ocean/ice salinity in the Baltic sea  
     112           DO jj = 1, jpj 
     113              DO ji = 1, jpi 
     114                 IF( glamt(ji,jj) >= 14. .AND.  glamt(ji,jj) <= 32. .AND. gphit(ji,jj) >= 54. .AND. gphit(ji,jj) <= 66. ) THEN  
     115                   soce_r(ji,jj) = 4.e0  
     116                   sice_r(ji,jj) = 2.e0 
     117                 END IF 
     118              END DO 
     119           END DO 
     120           ! 
     121         END IF 
     122      END IF 
    121123 
    122124      !------------------------------------------! 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r1758 r2007  
    360360         END DO 
    361361      ENDIF 
    362        
     362 
     363      CALL lbc_lnk( frld , 'T', 1. )       
    363364       
    364365      ! Select points for lateral accretion (this occurs when heat exchange 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90

    r1715 r2007  
    44   !! LIM 2.0 transport ice model : sea-ice advection/diffusion 
    55   !!====================================================================== 
     6   !! History :  LIM  !  2000-01 (UCL)  Original code 
     7   !!            2.0  !  2001-05 (G. Madec, R. Hordoir) opa norm 
     8   !!             -   !  2004-01 (G. Madec, C. Ethe)  F90, mpp 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_lim2 
    711   !!---------------------------------------------------------------------- 
    … …  
    1115   !!   lim_trp_init_2 : initialization and namelist read 
    1216   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    14    USE phycst 
    15    USE dom_oce 
     17   USE phycst          ! physical constant 
     18   USE sbc_oce         ! ocean surface boundary condition 
     19   USE dom_oce         ! ocean domain 
    1620   USE in_out_manager  ! I/O manager 
    17    USE dom_ice_2 
    18    USE ice_2 
    19    USE limistate_2 
    20    USE limadv_2 
    21    USE limhdf_2 
    22    USE lbclnk 
    23    USE lib_mpp 
     21   USE dom_ice_2       ! LIM-2 domain 
     22   USE ice_2           ! LIM-2 variables 
     23   USE limistate_2     ! LIM-2 initial state 
     24   USE limadv_2        ! LIM-2 advection 
     25   USE limhdf_2        ! LIM-2 horizontal diffusion 
     26   USE lbclnk          ! lateral boundary conditions -- MPP exchanges 
     27   USE lib_mpp         ! MPP library 
    2428 
    2529   IMPLICIT NONE 
    2630   PRIVATE 
    2731 
    28    !! * Routine accessibility 
    29    PUBLIC lim_trp_2     ! called by sbc_ice_lim_2 
    30  
    31    !! * Shared module variables 
    32    REAL(wp), PUBLIC  ::   &  !: 
    33       bound  = 0.e0          !: boundary condit. (0.0 no-slip, 1.0 free-slip) 
    34  
    35    !! * Module variables 
     32   PUBLIC   lim_trp_2   ! called by sbc_ice_lim_2 
     33 
     34   REAL(wp), PUBLIC  ::   bound  = 0.e0   !: boundary condit. (0.0 no-slip, 1.0 free-slip) 
     35 
    3636   REAL(wp)  ::           &  ! constant values 
    3737      epsi06 = 1.e-06  ,  & 
    … …  
    4444#  include "vectopt_loop_substitute.h90" 
    4545   !!---------------------------------------------------------------------- 
    46    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     46   !! NEMO/LIM 3.2,  UCL-LOCEAN-IPSL (2010)  
    4747   !! $Id$ 
    48    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     48   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 
    5050 
    … …  
    6262      !! 
    6363      !! ** action : 
    64       !! 
    65       !! History : 
    66       !!   1.0  !  00-01 (LIM)  Original code 
    67       !!        !  01-05 (G. Madec, R. Hordoir) opa norm 
    68       !!   2.0  !  04-01 (G. Madec, C. Ethe)  F90, mpp 
    6964      !!--------------------------------------------------------------------- 
    7065      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    71  
    72       INTEGER  ::   ji, jj, jk,   &  ! dummy loop indices 
    73          &          initad           ! number of sub-timestep for the advection 
    74  
    75       REAL(wp) ::  &                               
    76          zindb  ,  & 
    77          zacrith, & 
    78          zindsn , & 
    79          zindic , & 
    80          zusvosn, & 
    81          zusvoic, & 
    82          zignm  , & 
    83          zindhe , & 
    84          zvbord , & 
    85          zcfl   , & 
    86          zusnit , & 
    87          zrtt, ztsn, ztic1, ztic2 
    88  
    89       REAL(wp), DIMENSION(jpi,jpj)  ::   &  ! temporary workspace 
    90          zui_u , zvi_v , zsm   ,         & 
    91          zs0ice, zs0sn , zs0a  ,         & 
    92          zs0c0 , zs0c1 , zs0c2 ,         & 
    93          zs0st 
     66      !! 
     67      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     68      INTEGER  ::   initad       ! number of sub-timestep for the advection 
     69      REAL(wp) ::   zindb  , zindsn , zindic, zacrith   ! local scalars 
     70      REAL(wp) ::   zusvosn, zusvoic, zignm , zindhe    !   -      - 
     71      REAL(wp) ::   zvbord , zcfl   , zusnit            !   -      - 
     72      REAL(wp) ::   zrtt   , ztsn   , ztic1 , ztic2     !   -      - 
     73      REAL(wp), DIMENSION(jpi,jpj)  ::   zui_u , zvi_v , zsm             ! 2D workspace 
     74      REAL(wp), DIMENSION(jpi,jpj)  ::   zs0ice, zs0sn , zs0a            !  -      - 
     75      REAL(wp), DIMENSION(jpi,jpj)  ::   zs0c0 , zs0c1 , zs0c2 , zs0st   !  -      - 
    9476      !--------------------------------------------------------------------- 
    9577 
    … …  
    10587         ! ice velocities at ocean U- and V-points (zui_u,zvi_v) 
    10688         ! --------------------------------------- 
    107          ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions.         
    108          zvbord = 1.0 + ( 1.0 - bound ) 
     89         zvbord = 1.0 + ( 1.0 - bound )      ! zvbord=2 no-slip, =0 free slip boundary conditions         
    10990         DO jj = 1, jpjm1 
    11091            DO ji = 1, jpim1   ! NO vector opt. 
    … …  
    11394            END DO 
    11495         END DO 
    115          ! Lateral boundary conditions on zui_u, zvi_v 
    116          CALL lbc_lnk( zui_u, 'U', -1. ) 
    117          CALL lbc_lnk( zvi_v, 'V', -1. ) 
     96         CALL lbc_lnk( zui_u, 'U', -1. )   ;   CALL lbc_lnk( zvi_v, 'V', -1. )         ! Lateral boundary conditions 
     97 
    11898 
    11999         ! CFL test for stability 
    … …  
    122102         zcfl  = MAX( zcfl, MAXVAL( ABS( zui_u(1:jpim1, :     ) ) * rdt_ice / e1u(1:jpim1, :     ) ) ) 
    123103         zcfl  = MAX( zcfl, MAXVAL( ABS( zvi_v( :     ,1:jpjm1) ) * rdt_ice / e2v( :     ,1:jpjm1) ) ) 
    124  
    125          IF (lk_mpp ) CALL mpp_max(zcfl) 
    126  
    127          IF ( zcfl > 0.5 .AND. lwp )   WRITE(numout,*) 'lim_trp_2 : violation of cfl criterion the ',nday,'th day, cfl = ',zcfl 
     104         ! 
     105         IF(lk_mpp)   CALL mpp_max( zcfl ) 
     106         ! 
     107         IF( zcfl > 0.5 .AND. lwp )   WRITE(numout,*) 'lim_trp_2 : violation of cfl criterion the ',nday,'th day, cfl = ', zcfl 
    128108 
    129109         ! content of properties 
    130110         ! --------------------- 
    131111         zs0sn (:,:) =  hsnm(:,:) * area(:,:)                 ! Snow volume. 
    132          zs0ice(:,:) =  hicm (:,:) * area(:,:)                ! Ice volume. 
    133          zs0a  (:,:) =  ( 1.0 - frld(:,:) ) * area(:,:)       ! Surface covered by ice. 
    134          zs0c0 (:,:) =  tbif(:,:,1) / rt0_snow * zs0sn(:,:)   ! Heat content of the snow layer. 
     112         zs0ice(:,:) =  hicm(:,:) * area(:,:)                 ! Ice volume. 
     113         zs0a  (:,:) =  ( 1.0 - frld(:,:) )    * area  (:,:)  ! Surface covered by ice. 
     114         zs0c0 (:,:) =  tbif(:,:,1) / rt0_snow * zs0sn (:,:)  ! Heat content of the snow layer. 
    135115         zs0c1 (:,:) =  tbif(:,:,2) / rt0_ice  * zs0ice(:,:)  ! Heat content of the first ice layer. 
    136116         zs0c2 (:,:) =  tbif(:,:,3) / rt0_ice  * zs0ice(:,:)  ! Heat content of the second ice layer. 
    137          zs0st (:,:) =  qstoif(:,:) / xlic     * zs0a(:,:)    ! Heat reservoir for brine pockets. 
     117         zs0st (:,:) =  qstoif(:,:) / xlic     * zs0a  (:,:)  ! Heat reservoir for brine pockets. 
    138118          
    139119  
    140          ! Advection  
     120         ! Advection (Prather scheme) 
    141121         ! --------- 
    142          ! If ice drift field is too fast, use an appropriate time step for advection.          
    143          initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
    144          zusnit = 1.0 / REAL( initad )  
    145           
    146          IF ( MOD( nday , 2 ) == 0) THEN 
    147             DO jk = 1,initad 
     122         initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) )   ! If ice drift field is too fast,           
     123         zusnit = 1.0 / REAL( initad )                              ! split the ice time step in two 
     124         ! 
     125         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0) THEN        !==  odd ice time step:  adv_x then adv_y  ==! 
     126            DO jk = 1, initad 
    148127               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 
    149128               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 
    … …  
    161140               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  ) 
    162141            END DO 
    163          ELSE 
     142         ELSE                                                 !==  even ice time step:  adv_x then adv_y  ==! 
    164143            DO jk = 1, initad 
    165144               CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 
    … …  
    182161         ! recover the properties from their contents 
    183162         ! ------------------------------------------ 
     163!!gm Define in limmsh one for all area = 1 /area  (CPU time saved !) 
    184164         zs0ice(:,:) = zs0ice(:,:) / area(:,:) 
    185165         zs0sn (:,:) = zs0sn (:,:) / area(:,:) 
    … …  
    205185            END DO 
    206186         END DO 
     187!!gm more readable coding: (and avoid an error in F90 with sign of zero) 
     188!        DO jj = 1, jpjm1          ! NB: has not to be defined on jpj line and jpi row 
     189!           DO ji = 1 , fs_jpim1   ! vector opt. 
     190!              IF( MIN( zs0a(ji,jj) , zs0a(ji+1,jj) ) == 0.e0 )   pahu(ji,jj) = 0.e0 
     191!              IF( MIN( zs0a(ji,jj) , zs0a(ji,jj+1) ) == 0.e0 )   pahv(ji,jj) = 0.e0 
     192!           END DO 
     193!        END DO 
     194!!gm end 
    207195 
    208196         ! diffusion 
    … …  
    216204         CALL lim_hdf_2( zs0st  ) 
    217205 
    218          zs0ice(:,:) = MAX( rzero, zs0ice(:,:) * area(:,:) )    !!bug:  est-ce utile 
    219          zs0sn (:,:) = MAX( rzero, zs0sn (:,:) * area(:,:) )    !!bug:  cf /area  juste apres 
    220          zs0a  (:,:) = MAX( rzero, zs0a  (:,:) * area(:,:) )    !! suppression des 2 change le resultat... 
    221          zs0c0 (:,:) = MAX( rzero, zs0c0 (:,:) * area(:,:) ) 
     206!!gm see comment this can be skipped 
     207         zs0ice(:,:) = MAX( rzero, zs0ice(:,:) * area(:,:) )    !!bug:  useless 
     208         zs0sn (:,:) = MAX( rzero, zs0sn (:,:) * area(:,:) )    !!bug:  cf /area  just below 
     209         zs0a  (:,:) = MAX( rzero, zs0a  (:,:) * area(:,:) )    !! caution: the suppression of the 2 changes  
     210         zs0c0 (:,:) = MAX( rzero, zs0c0 (:,:) * area(:,:) )    !! the last digit of the results 
    222211         zs0c1 (:,:) = MAX( rzero, zs0c1 (:,:) * area(:,:) ) 
    223212         zs0c2 (:,:) = MAX( rzero, zs0c2 (:,:) * area(:,:) ) 
    … …  
    225214 
    226215 
    227          ! -------------------------------------------------------------------! 
    228          !   Up-dating and limitation of sea ice properties after transport   ! 
    229          ! -------------------------------------------------------------------! 
    230  
    231          ! Up-dating and limitation of sea ice properties after transport. 
     216         !-------------------------------------------------------------------! 
     217         !   Updating and limitation of sea ice properties after transport   ! 
     218         !-------------------------------------------------------------------! 
    232219         DO jj = 1, jpj 
    233 !!!iii      zindhe = REAL( MAX( 0, isign(1, jj - njeq ) ) )              !ibug mpp  !!bugmpp  njeq! 
    234220            zindhe = MAX( 0.e0, SIGN( 1.e0, fcor(1,jj) ) )              ! = 0 for SH, =1 for NH 
    235221            DO ji = 1, jpi 
    236  
     222               ! 
    237223               ! Recover mean values over the grid squares. 
    238224               zs0sn (ji,jj) = MAX( rzero, zs0sn (ji,jj)/area(ji,jj) ) 
    … …  
    272258            END DO 
    273259         END DO 
    274           
     260         ! 
    275261      ENDIF 
    276        
     262      ! 
    277263   END SUBROUTINE lim_trp_2 
    278264 
    … …  
    284270      !! ** Purpose :   initialization of ice advection parameters 
    285271      !! 
    286       !! ** Method  : Read the namicetrp namelist and check the parameter  
    287       !!       values called at the first timestep (nit000) 
     272      !! ** Method  :   Read the namicetrp namelist and check the parameter  
     273      !!              values called at the first timestep (nit000) 
    288274      !! 
    289275      !! ** input   :   Namelist namicetrp 
    290       !! 
    291       !! history : 
    292       !!   2.0  !  03-08 (C. Ethe)  Original code 
    293276      !!------------------------------------------------------------------- 
    294277      NAMELIST/namicetrp/ bound 
    295278      !!------------------------------------------------------------------- 
    296  
    297       ! Read Namelist namicetrp 
    298       REWIND ( numnam_ice ) 
     279      ! 
     280      REWIND ( numnam_ice )      ! Read Namelist namicetrp 
    299281      READ   ( numnam_ice  , namicetrp ) 
    300282      IF(lwp) THEN 
    … …  
    304286         WRITE(numout,*) '   boundary conditions (0. no-slip, 1. free-slip) bound  = ', bound 
    305287      ENDIF 
    306              
     288      ! 
    307289   END SUBROUTINE lim_trp_init_2 
    308290 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90

    r1715 r2007  
    313313      CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) ) 
    314314      CALL histwrite( kid, "ioceflxb", kt, fbif           , jpi*jpj, (/1/) ) 
    315       CALL histwrite( kid, "iicevelv", kt, u_ice          , jpi*jpj, (/1/) ) 
    316       CALL histwrite( kid, "iicevelu", kt, v_ice          , jpi*jpj, (/1/) ) 
     315      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) ) 
     316      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) ) 
    317317      CALL histwrite( kid, "isstempe", kt, sst_m          , jpi*jpj, (/1/) ) 
    318318      CALL histwrite( kid, "isssalin", kt, sss_m          , jpi*jpj, (/1/) ) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90

    r1694 r2007  
    5353         WRITE(numout,*) '~~~~~~~' 
    5454      ENDIF 
     55 
     56      IF( jphgr_msh == 2 .OR. jphgr_msh == 3 .OR. jphgr_msh == 5 )   & 
     57          &      CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane' ) 
    5558 
    5659      !                           !==  coriolis factor & Equator position ==! 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r1715 r2007  
    204204         zusnit = 1.0 / REAL( initad )  
    205205 
    206          IF ( MOD( nday , 2 ) == 0) THEN 
     206         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0) THEN        !==  odd ice time step:  adv_x then adv_y  ==! 
    207207            DO jk = 1,initad 
    208208               !--- ice open water area 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/NST_SRC/agrif2model.F90

    r1156 r2007  
    7373 
    7474   END SUBROUTINE Agrif_clustering_def 
     75 
     76   SUBROUTINE Agrif_comm_def(modelcomm) 
     77 
     78      !!--------------------------------------------- 
     79      !!   *** ROUTINE Agrif_clustering_def *** 
     80      !!---------------------------------------------  
     81      Use Agrif_Types 
     82      Use lib_mpp 
     83 
     84      IMPLICIT NONE 
     85 
     86      INTEGER :: modelcomm 
     87 
     88#if defined key_mpp_mpi 
     89      modelcomm = mpi_comm_opa 
     90#endif 
     91      Return 
     92 
     93   END SUBROUTINE Agrif_comm_def 
    7594#else 
    7695   SUBROUTINE Agrif2Model 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r1605 r2007  
    7373      USE tradmp 
    7474#endif 
     75#if defined key_obc   ||   defined key_esopa 
     76      USE obc_par 
     77#endif 
    7578      USE sol_oce 
    7679      USE in_out_manager 
    … …  
    105108      ! no tracer damping on fine grids 
    106109      lk_tradmp = .FALSE. 
     110#endif 
     111#if defined key_obc || defined key_esopa 
     112      ! no open boundary on fine grids 
     113      lk_obc = .FALSE. 
    107114#endif 
    108115      ! 1. Declaration of the type of variable which have to be interpolated 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OFF_SRC/DOM/domrea.F90

    r1641 r2007  
    215215 
    216216  
    217          DO jk = 1,jpk 
    218             gdept(:,:,jk) = gdept_0(jk) 
    219             gdepw(:,:,jk) = gdepw_0(jk) 
    220          END DO 
    221           
    222  
    223217         IF( ln_zps ) THEN    
     218            ! Vertical coordinates and scales factors 
     219            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth 
     220            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 ) 
     221            CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   ) 
     222            CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   ) 
    224223                                      ! z-coordinate - partial steps 
    225224            IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors 
    … …  
    233232            END IF 
    234233 
    235             IF( nmsh <= 3 ) THEN                                   !    ! 3D depth 
     234            IF( iom_varid( inum4, 'gdept', ldstop = .FALSE. ) > 0 ) THEN 
    236235              CALL iom_get( inum4, jpdom_data, 'gdept', gdept ) ! scale factors 
    237236              CALL iom_get( inum4, jpdom_data, 'gdepw', gdepw ) 
    … …  
    240239              CALL iom_get( inum4, jpdom_data, 'hdepw', hdepw ) 
    241240          
     241              DO jk = 1,jpk 
     242                gdept(:,:,jk) = gdept_0(jk) 
     243                gdepw(:,:,jk) = gdepw_0(jk) 
     244              ENDDO 
     245 
    242246              DO jj = 1, jpj 
    243247                DO ji = 1, jpi 
    … …  
    252256                END DO 
    253257              END DO 
     258 
    254259            ENDIF 
    255260 
    256261         ENDIF 
    257          ! Vertical coordinates and scales factors 
    258          CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth 
    259          CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 ) 
    260          CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   ) 
    261          CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   ) 
    262262# endif 
    263263         IF( ln_zco ) THEN 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OFF_SRC/DOM/phycst.F90

    r1746 r2007  
    3737      rtt      = 273.16_wp  ,  &  !: triple point of temperature (Kelvin) 
    3838      rt0      = 273.15_wp  ,  &  !: freezing point of water (Kelvin) 
    39       rau0     = 1020._wp   ,  &  !: volumic mass of reference (kg/m3) 
    40       rauw     = 1000._wp   ,  &  !: density of pure water (kg/m3) 
     39      rau0     = 1035._wp   ,  &  !: volumic mass of reference (kg/m3) 
    4140      rcp      =    4.e+3_wp,  &  !: ocean specific heat 
    4241      ro0cpr                      !: = 1. / ( rau0 * rcp ) 
    … …  
    127126      ro0cpr = 1. / ( rau0 * rcp ) 
    128127      IF(lwp) WRITE(numout,*) 
    129       IF(lwp) WRITE(numout,*) '          volumic mass of pure water         rauw   = ', rauw, ' kg/m^3' 
    130128      IF(lwp) WRITE(numout,*) '          volumic mass of reference          rau0   = ', rau0, ' kg/m^3' 
    131129      IF(lwp) WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OFF_SRC/lib_mpp.F90

    r1324 r2007  
    105105   !! ========================= !! 
    106106!$AGRIF_DO_NOT_TREAT 
    107 #  include <mpif.h> 
     107   INCLUDE mpif.h 
    108108!$AGRIF_END_DO_NOT_TREAT 
    109109 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OFF_SRC/trc_oce.F90

    r1445 r2007  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    41    !! $Id: trc_oce.F90 1423 2009-05-06 16:22:01Z ctlod $  
     41   !! $Id: trc_oce.F90 1834 2010-04-14 11:54:19Z cetlod $  
    4242   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    4343   !!---------------------------------------------------------------------- 
    … …  
    126126      zrgb(1,51) =  3.162   ;   zrgb(2,51) = 0.22703   ;   zrgb(3,51) = 0.16599   ;   zrgb(4,51) = 0.46601 
    127127      zrgb(1,52) =  3.548   ;   zrgb(2,52) = 0.24433   ;   zrgb(3,52) = 0.17334   ;   zrgb(4,52) = 0.47313 
    128       zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,54) = 0.48080 
    129       zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,55) = 0.48909 
    130       zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,56) = 0.49803 
    131       zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,57) = 0.50768 
    132       zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,58) = 0.51810 
    133       zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,59) = 0.52934 
    134       zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,50) = 0.54147 
     128      zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,53) = 0.48080 
     129      zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,54) = 0.48909 
     130      zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,55) = 0.49803 
     131      zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,56) = 0.50768 
     132      zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,57) = 0.51810 
     133      zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,58) = 0.52934 
     134      zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,59) = 0.54147 
    135135      zrgb(1,60) =  8.912   ;   zrgb(2,60) = 0.44336   ;   zrgb(3,60) = 0.25725   ;   zrgb(4,60) = 0.55457 
    136136      zrgb(1,61) = 10.000   ;   zrgb(2,61) = 0.47804   ;   zrgb(3,61) = 0.27178   ;   zrgb(4,61) = 0.56870 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r1756 r2007  
    175175      thick0(:,:) = 0.e0 
    176176      DO jk = 1, jpkm1 
    177          vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) ) * e3t_0(jk)  
    178          thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk)   * e3t_0(jk) 
    179       END DO 
     177         vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) ) 
     178         thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) 
     179      END DO 
     180      IF( lk_mpp )   CALL mpp_sum( vol0 ) 
    180181       
    181182      CALL iom_open ( 'data_1m_salinity_nomask', inum ) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90

    r1715 r2007  
    1010   USE dom_oce         ! ocean space and time domain 
    1111   USE in_out_manager  ! I/O manager 
     12   USE daymod          ! calendar 
    1213 
    1314   IMPLICIT NONE 
    … …  
    2122   !!---------------------------------------------------------------------- 
    2223   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    23    !! $Id$  
     24   !! $Header$  
    2425   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    2526   !!---------------------------------------------------------------------- 
    … …  
    5657    INTEGER :: jk, jn           ! dummy loop indices 
    5758    INTEGER :: irecl4,             &    ! record length in bytes 
    58          &       inum,             &    ! logical unit 
    59          &       irec                   ! current record to be written 
     59         &       inum,             &    ! logical unit (set to 14) 
     60         &       irec,             &    ! current record to be written 
     61         &       irecend                ! record number where nclit... are stored 
    6062    REAL(sp)                    :: zdx,zdy,zspval,zwest,ztimm 
    6163    REAL(sp)                    :: zsouth 
    … …  
    6971    !! * Initialisations 
    7072 
    71     irecl4 = MAX(jpi*jpj*sp , 84+18*sp + (jpk+8)*jpnij*sp ) 
     73    irecl4 = MAX(jpi*jpj*sp , 84+(18+1+jpk)*sp ) 
    7274 
    7375    zspval=0.0_sp    ! special values on land 
    … …  
    101103 
    102104    IF ( ln_dimgnnn  ) THEN 
     105     irecl4 = MAX(jpi*jpj*sp , 84+(18+jpk)*sp + 8*jpnij*sp  ) 
    103106       WRITE(clname,'(a,a,i3.3)') TRIM(cd_name),'.',narea 
    104        CALL ctl_opn( inum, clname, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp ) 
     107       CALL ctl_opn(inum, clname,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp) 
    105108       WRITE(inum,REC=1 ) clver, cd_text, irecl4, & 
    106109            &     jpi,jpj, klev, 1 , 1 ,            & 
    … …  
    127130       ENDIF 
    128131    ELSE 
     132       clver='@!03'           ! dimg string identifier 
     133       ! note that version @!02 is optimized with respect to record length. 
     134       ! The vertical dep variable is reduced to klev instead of klev*jpnij : 
     135       !   this is OK for jpnij < 181 (jpk=46) 
     136       ! for more processors, irecl4 get huge and that's why we switch to '@!03': 
     137       !  In this case we just add an extra integer to the standard dimg structure, 
     138       !  which is a record number where the arrays nlci etc... starts (1 per record) 
     139        
    129140       !! Standard dimgproc (1 file per variable, all procs. write to this file ) 
    130141       !! * Open file 
    131        CALL ctl_opn( inum, cd_name, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp ) 
     142       CALL ctl_opn(inum, cd_name,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp) 
    132143 
    133144       !! * Write header on record #1 
     145       irecend=1 + klev*jpnij  
    134146       IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, & 
    135             &     jpi,jpj, klev*jpnij, 1 , 1 ,            & 
     147            &     jpi,jpj, klev, 1 , 1 ,            & 
    136148            &     zwest, zsouth, zdx, zdy, zspval,  & 
    137             &     (z4dep(1:klev),jn=1,jpnij),       & 
     149            &     z4dep(1:klev),       & 
    138150            &     ztimm,                            & 
    139             &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom,    &    ! extension to dimg for mpp output 
    140             &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  ! 
     151            &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, irecend  
     152       IF (lwp ) THEN 
     153         WRITE(inum,REC=irecend + 1 ) nlcit 
     154         WRITE(inum,REC=irecend + 2 ) nlcjt 
     155         WRITE(inum,REC=irecend + 3 ) nldit 
     156         WRITE(inum,REC=irecend + 4 ) nldjt 
     157         WRITE(inum,REC=irecend + 5 ) nleit 
     158         WRITE(inum,REC=irecend + 6 ) nlejt 
     159         WRITE(inum,REC=irecend + 7 ) nimppt 
     160         WRITE(inum,REC=irecend + 8 ) njmppt 
     161       ENDIF 
     162      !   &    ! extension to dimg for mpp output 
     163      !   &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  ! 
    141164 
    142165       !! * Write klev levels 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90

    r1731 r2007  
    129129  
    130130      cdfnam = TRIM(cexper)//TRIM(clave)//"_"//TRIM(cldate1)//"_"//TRIM(cldate2)//"_"//TRIM(cdsuff) 
    131 #if defined key_agrif 
    132       if ( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam) 
    133 #endif     
     131      IF( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam) 
    134132 
    135133   END SUBROUTINE dia_nam 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r1775 r2007  
    362362#endif 
    363363 
     364            ! Transports 
     365            ! T times V on T points (include bolus velocities) 
     366#if defined key_diaeiv  
     367            DO jj = 2, jpj 
     368               DO ji = 1, jpi 
     369                  vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5 
     370                  vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5 
     371               END DO 
     372            END DO 
     373#else 
     374            DO jj = 2, jpj 
     375               DO ji = 1, jpi 
     376                  vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
     377                  vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
     378               END DO 
     379            END DO 
     380#endif  
     381            CALL lbc_lnk( vs, 'V', -1. )   ;   CALL lbc_lnk( vt, 'V', -1. ) 
     382 
     383            ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 ) 
     384            st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 ) 
     385 
     386            IF ( ln_subbas ) THEN  
     387               ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
     388               ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
     389               ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
     390               ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
     391               st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
     392               st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
     393               st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
     394               st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
     395            ENDIF 
     396 
     397            ! poleward tracer transports:  
     398            ! overturning components: 
     399            IF ( ln_ptrcomp ) THEN  
     400               pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
     401               pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 )   
     402               IF ( ln_subbas ) THEN  
     403                  pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk 
     404                  pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 )   
     405                  pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk 
     406                  pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 )   
     407                  pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk 
     408                  pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 )   
     409                  pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk 
     410                  pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 )   
     411               END IF 
     412            END IF 
     413 
     414            ! Bolus component 
     415#if defined key_diaeiv 
     416            pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
     417            pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 )   ! SUM over jk 
     418            IF ( ln_subbas ) THEN  
     419               pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk 
     420               pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 )   ! SUM over jk 
     421               pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk 
     422               pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 )   ! SUM over jk 
     423               pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk 
     424               pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 )   ! SUM over jk 
     425               pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk 
     426               pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 )   ! SUM over jk 
     427            ENDIF 
     428#endif 
     429 
     430            ! conversion in PW and G g 
     431            zpwatt = zpwatt * rau0 * rcp 
     432            pht_adv(:) = pht_adv(:) * zpwatt   
     433            pht_ldf(:) = pht_ldf(:) * zpwatt 
     434            pst_adv(:) = pst_adv(:) * zggram 
     435            pst_ldf(:) = pst_ldf(:) * zggram 
     436            IF ( ln_ptrcomp ) THEN  
     437               pht_ove_glo(:) = pht_ove_glo(:) * zpwatt 
     438               pst_ove_glo(:) = pst_ove_glo(:) * zggram 
     439            END IF 
     440#if defined key_diaeiv 
     441            pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt 
     442            pst_eiv_glo(:) = pst_eiv_glo(:) * zggram 
     443#endif 
     444            IF( ln_subbas ) THEN 
     445               ht_atl(:) = ht_atl(:) * zpwatt 
     446               ht_pac(:) = ht_pac(:) * zpwatt 
     447               ht_ind(:) = ht_ind(:) * zpwatt 
     448               ht_ipc(:) = ht_ipc(:) * zpwatt 
     449               st_atl(:) = st_atl(:) * zggram  
     450               st_pac(:) = st_pac(:) * zggram 
     451               st_ind(:) = st_ind(:) * zggram 
     452               st_ipc(:) = st_ipc(:) * zggram 
     453            ENDIF 
     454 
    364455            ! "Meridional" Stream-Function 
    365456            DO jk = 2,jpk  
    … …  
    394485               v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 
    395486               v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 
    396             ENDIF 
    397  
    398             ! Transports 
    399             ! T times V on T points (include bolus velocities) 
    400 #if defined key_diaeiv  
    401             DO jj = 2, jpj 
    402                DO ji = 1, jpi 
    403                   vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5 
    404                   vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5 
    405                END DO 
    406             END DO 
    407 #else 
    408             DO jj = 2, jpj 
    409                DO ji = 1, jpi 
    410                   vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
    411                   vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
    412                END DO 
    413             END DO 
    414 #endif  
    415             CALL lbc_lnk( vs, 'V', -1. )   ;   CALL lbc_lnk( vt, 'V', -1. ) 
    416  
    417             ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 ) 
    418             st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 ) 
    419  
    420             IF ( ln_subbas ) THEN  
    421                ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
    422                ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
    423                ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
    424                ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
    425                st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
    426                st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
    427                st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
    428                st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
    429             ENDIF 
    430  
    431             ! poleward tracer transports:  
    432             ! overturning components: 
    433             IF ( ln_ptrcomp ) THEN  
    434                pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
    435                pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 )   
    436                IF ( ln_subbas ) THEN  
    437                   pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk 
    438                   pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 )   
    439                   pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk 
    440                   pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 )   
    441                   pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk 
    442                   pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 )   
    443                   pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk 
    444                   pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 )   
    445                END IF 
    446             END IF 
    447  
    448             ! Bolus component 
    449 #if defined key_diaeiv 
    450             pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
    451             pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 )   ! SUM over jk 
    452             IF ( ln_subbas ) THEN  
    453                pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk 
    454                pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 )   ! SUM over jk 
    455                pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk 
    456                pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 )   ! SUM over jk 
    457                pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk 
    458                pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 )   ! SUM over jk 
    459                pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk 
    460                pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 )   ! SUM over jk 
    461             ENDIF 
    462 #endif 
    463  
    464             ! conversion in PW and G g 
    465             zpwatt = zpwatt * rau0 * rcp 
    466             pht_adv(:) = pht_adv(:) * zpwatt   
    467             pht_ldf(:) = pht_ldf(:) * zpwatt 
    468             pst_adv(:) = pst_adv(:) * zggram 
    469             pst_ldf(:) = pst_ldf(:) * zggram 
    470             IF ( ln_ptrcomp ) THEN  
    471                pht_ove_glo(:) = pht_ove_glo(:) * zpwatt 
    472                pst_ove_glo(:) = pst_ove_glo(:) * zggram 
    473             END IF 
    474 #if defined key_diaeiv 
    475             pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt 
    476             pst_eiv_glo(:) = pst_eiv_glo(:) * zggram 
    477 #endif 
    478             IF( ln_subbas ) THEN 
    479                ht_atl(:) = ht_atl(:) * zpwatt 
    480                ht_pac(:) = ht_pac(:) * zpwatt 
    481                ht_ind(:) = ht_ind(:) * zpwatt 
    482                ht_ipc(:) = ht_ipc(:) * zpwatt 
    483                st_atl(:) = st_atl(:) * zggram  
    484                st_pac(:) = st_pac(:) * zggram 
    485                st_ind(:) = st_ind(:) * zggram 
    486                st_ipc(:) = st_ipc(:) * zggram 
    487487            ENDIF 
    488488         ENDIF 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r1756 r2007  
    629629      ! Define name, frequency of output and means 
    630630      clname = cdfile_name 
    631 #if defined key_agrif 
    632       if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    633 #endif 
     631      IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    634632      zdt  = rdt 
    635633      zsto = rdt 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r1730 r2007  
    219219#else 
    220220   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag 
     221 
     222CONTAINS 
     223   LOGICAL FUNCTION Agrif_Root() 
     224      Agrif_Root = .TRUE. 
     225   END FUNCTION Agrif_Root 
     226 
     227   CHARACTER(len=3) FUNCTION Agrif_CFixed() 
     228     Agrif_CFixed = '0'  
     229   END FUNCTION Agrif_CFixed 
    221230#endif 
    222231 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r1732 r2007  
    166166      ENDIF 
    167167 
    168 #if defined key_agrif 
    169168      IF( Agrif_Root() ) THEN 
    170 #endif 
    171       SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    172       CASE (  1 )  
    173          CALL ioconf_calendar('gregorian') 
    174          IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year' 
    175       CASE (  0 ) 
    176          CALL ioconf_calendar('noleap') 
    177          IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year' 
    178       CASE ( 30 ) 
    179          CALL ioconf_calendar('360d') 
    180          IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
    181       END SELECT 
    182 #if defined key_agrif 
    183       ENDIF 
    184 #endif 
     169         SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     170         CASE (  1 )  
     171            CALL ioconf_calendar('gregorian') 
     172            IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year' 
     173         CASE (  0 ) 
     174            CALL ioconf_calendar('noleap') 
     175            IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year' 
     176         CASE ( 30 ) 
     177            CALL ioconf_calendar('360d') 
     178            IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     179         END SELECT 
     180      ENDIF 
    185181 
    186182      REWIND( numnam )             ! Namelist namdom : space & time domain (bathymetry, mesh, timestep) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r1707 r2007  
    270270          
    271271#if defined key_agrif && defined key_eel_r6 
    272          IF (.Not.Agrif_Root()) THEN 
     272         IF( .NOT. Agrif_Root() ) THEN 
    273273           glam0  = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-3 
    274274           gphi0  = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-3 
    … …  
    465465          
    466466#if defined key_agrif && defined key_eel_r6 
    467          IF (.Not.Agrif_Root()) THEN 
     467         IF( .NOT. Agrif_Root() ) THEN 
    468468           zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
    469469         ENDIF 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r1694 r2007  
    6262      IF( lk_zco )   CALL ctl_stop( 'dom_vvl : key_zco is incompatible with variable volume option key_vvl') 
    6363 
    64       fsdept(:,:,:) = gdept (:,:,:) 
    65       fsdepw(:,:,:) = gdepw (:,:,:) 
    66       fsde3w(:,:,:) = gdep3w(:,:,:) 
    67       fse3t (:,:,:) = e3t   (:,:,:) 
    68       fse3u (:,:,:) = e3u   (:,:,:) 
    69       fse3v (:,:,:) = e3v   (:,:,:) 
    70       fse3f (:,:,:) = e3f   (:,:,:) 
    71       fse3w (:,:,:) = e3w   (:,:,:) 
    72       fse3uw(:,:,:) = e3uw  (:,:,:) 
    73       fse3vw(:,:,:) = e3vw  (:,:,:) 
     64      IF( ln_zco) THEN 
     65         DO jk = 1, jpk 
     66            gdept(:,:,jk) = gdept_0(jk) 
     67            gdepw(:,:,jk) = gdepw_0(jk) 
     68            gdep3w(:,:,jk) = gdepw_0(jk) 
     69            e3t (:,:,jk) = e3t_0(jk) 
     70            e3u (:,:,jk) = e3t_0(jk) 
     71            e3v (:,:,jk) = e3t_0(jk) 
     72            e3f (:,:,jk) = e3t_0(jk) 
     73            e3w (:,:,jk) = e3w_0(jk) 
     74            e3uw(:,:,jk) = e3w_0(jk) 
     75            e3vw(:,:,jk) = e3w_0(jk) 
     76         END DO 
     77      ELSE 
     78         fsdept(:,:,:) = gdept (:,:,:) 
     79         fsdepw(:,:,:) = gdepw (:,:,:) 
     80         fsde3w(:,:,:) = gdep3w(:,:,:) 
     81         fse3t (:,:,:) = e3t   (:,:,:) 
     82         fse3u (:,:,:) = e3u   (:,:,:) 
     83         fse3v (:,:,:) = e3v   (:,:,:) 
     84         fse3f (:,:,:) = e3f   (:,:,:) 
     85         fse3w (:,:,:) = e3w   (:,:,:) 
     86         fse3uw(:,:,:) = e3uw  (:,:,:) 
     87         fse3vw(:,:,:) = e3vw  (:,:,:) 
     88      ENDIF 
    7489 
    7590      !                                 !==  mu computation  ==! 
    … …  
    139154      CALL lbc_lnk( sshf_b, 'F', 1. )   ;   CALL lbc_lnk( sshf_n, 'F', 1. ) 
    140155      ! 
     156         DO jk = 1, jpkm1 
     157            fsdept(:,:,jk) = fsdept_n(:,:,jk)          ! now local depths stored in fsdep. arrays 
     158            fsdepw(:,:,jk) = fsdepw_n(:,:,jk) 
     159            fsde3w(:,:,jk) = fsde3w_n(:,:,jk) 
     160            ! 
     161            fse3t (:,:,jk) = fse3t_n (:,:,jk)          ! vertical scale factors stored in fse3. arrays 
     162            fse3u (:,:,jk) = fse3u_n (:,:,jk) 
     163            fse3v (:,:,jk) = fse3v_n (:,:,jk) 
     164            fse3f (:,:,jk) = fse3f_n (:,:,jk) 
     165            fse3w (:,:,jk) = fse3w_n (:,:,jk) 
     166            fse3uw(:,:,jk) = fse3uw_n(:,:,jk) 
     167            fse3vw(:,:,jk) = fse3vw_n(:,:,jk) 
     168         END DO 
     169 
     170 
     171 
    141172   END SUBROUTINE dom_vvl 
    142173 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r1590 r2007  
    4545      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on 
    4646      !!      the vertical coord. used (z-coord, partial steps, s-coord) 
    47       !!                    nmsh = 1  :   'mesh_mask.nc' file 
     47      !!            MOD(nmsh, 3) = 1  :   'mesh_mask.nc' file 
    4848      !!                         = 2  :   'mesh.nc' and mask.nc' files 
    49       !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and 
     49      !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and 
    5050      !!                                  'mask.nc' files 
    5151      !!      For huge size domain, use option 2 or 3 depending on your  
    5252      !!      vertical coordinate. 
     53      !! 
     54      !!      if     nmsh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw] 
     55      !!      if 3 < nmsh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays  
     56      !!                        corresponding to the depth of the bottom points hdep[tw] 
     57      !!      if 6 < nmsh <= 9: write 2D arrays corresponding to the depth and the 
     58      !!                        thickness of the bottom points hdep[tw] and e3[tw]_ps 
    5359      !! 
    5460      !! ** output file :  
    … …  
    241247      !                                     !        close the files  
    242248      !                                     ! ============================ 
    243       SELECT CASE ( nmsh ) 
     249      SELECT CASE ( MOD(nmsh, 3) ) 
    244250      CASE ( 1 )                 
    245251         CALL iom_close( inum0 ) 
    … …  
    247253         CALL iom_close( inum1 ) 
    248254         CALL iom_close( inum2 ) 
    249       CASE ( 3 ) 
     255      CASE ( 0 ) 
    250256         CALL iom_close( inum2 ) 
    251257         CALL iom_close( inum3 ) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r1739 r2007  
    44   !!     Definition of of both ocean and ice parameters used in the code 
    55   !!===================================================================== 
    6    !! History :        !  90-10  (C. Levy - G. Madec)  Original code 
    7    !!                  !  91-11  (G. Madec) 
    8    !!                  !  91-12  (M. Imbard) 
    9    !!             8.5  !  02-08  (G. Madec, C. Ethe)  F90, add ice constants 
    10    !!             9.0  !  06-08  (G. Madec) style  
     6   !! History :   OPA  !  1990-10  (C. Levy - G. Madec)  Original code 
     7   !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes 
     8   !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants 
     9   !!              -   !  2006-08  (G. Madec)  style  
     10   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style  
    1111   !!---------------------------------------------------------------------- 
    1212 
    … …  
    2424   REAL(wp), PUBLIC ::   rpi = 3.141592653589793_wp             !: pi 
    2525   REAL(wp), PUBLIC ::   rad = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian 
    26    REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1. )           !: smallest real computer value 
     26   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1.e0 )         !: smallest real computer value 
    2727    
    28    REAL(wp), PUBLIC ::          & !: 
    29       rday = 24.*60.*60.  ,     & !: day (s) 
    30       rsiyea              ,     & !: sideral year (s) 
    31       rsiday              ,     & !: sideral day (s) 
    32       raamo =  12._wp     ,     & !: number of months in one year 
    33       rjjhh =  24._wp     ,     & !: number of hours in one day 
    34       rhhmm =  60._wp     ,     & !: number of minutes in one hour 
    35       rmmss =  60._wp     ,     & !: number of seconds in one minute 
    36 !!!   omega = 7.292115083046061e-5_wp ,  &  !: change the last digit! 
    37       omega               ,    &  !: earth rotation parameter 
    38       ra    = 6371229._wp ,    &  !: earth radius (meter) 
    39       grav  = 9.80665_wp          !: gravity (m/s2) 
     28   REAL(wp), PUBLIC ::   rday = 24.*60.*60.       !: day (s) 
     29   REAL(wp), PUBLIC ::   rsiyea                   !: sideral year (s) 
     30   REAL(wp), PUBLIC ::   rsiday                   !: sideral day (s) 
     31   REAL(wp), PUBLIC ::   raamo =  12._wp          !: number of months in one year 
     32   REAL(wp), PUBLIC ::   rjjhh =  24._wp          !: number of hours in one day 
     33   REAL(wp), PUBLIC ::   rhhmm =  60._wp          !: number of minutes in one hour 
     34   REAL(wp), PUBLIC ::   rmmss =  60._wp          !: number of seconds in one minute 
     35!! REAL(wp), PUBLIC ::   omega = 7.292115083046061e-5_wp ,  &  !: change the last digit! 
     36   REAL(wp), PUBLIC ::   omega                    !: earth rotation parameter 
     37   REAL(wp), PUBLIC ::   ra    = 6371229._wp      !: earth radius (meter) 
     38   REAL(wp), PUBLIC ::   grav  = 9.80665_wp       !: gravity (m/s2) 
    4039    
    41    REAL(wp), PUBLIC ::         &  !: 
    42       rtt      = 273.16_wp  ,  &  !: triple point of temperature (Kelvin) 
    43       rt0      = 273.15_wp  ,  &  !: freezing point of water (Kelvin) 
     40   REAL(wp), PUBLIC ::   rtt      = 273.16_wp     !: triple point of temperature (Kelvin) 
     41   REAL(wp), PUBLIC ::   rt0      = 273.15_wp     !: freezing point of water (Kelvin) 
    4442#if defined key_lim3 
    45       rt0_snow = 273.16_wp  ,  &  !: melting point of snow  (Kelvin) 
    46       rt0_ice  = 273.16_wp  ,  &  !: melting point of ice   (Kelvin) 
     43   REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp     !: melting point of snow  (Kelvin) 
     44   REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp     !: melting point of ice   (Kelvin) 
    4745#else 
    48       rt0_snow = 273.15_wp  ,  &  !: melting point of snow  (Kelvin) 
    49       rt0_ice  = 273.05_wp  ,  &  !: melting point of ice   (Kelvin) 
     46   REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp     !: melting point of snow  (Kelvin) 
     47   REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp     !: melting point of ice   (Kelvin) 
    5048#endif 
    51       rau0     = 1035._wp   ,  &  !: volumic mass of reference (kg/m3) 
    52       rauw     = 1000._wp   ,  &  !: volumic mass of pure water (kg/m3) 
    53       rcp      =    4.e+3_wp,  &  !: ocean specific heat 
    54       ro0cpr                      !: = 1. / ( rau0 * rcp ) 
    5549 
    56    REAL(wp), PUBLIC ::            &  !: 
     50   REAL(wp), PUBLIC ::   rau0     = 1020._wp      !: reference volumic mass (density)  (kg/m3) 
     51   REAL(wp), PUBLIC ::   rau0r                    !: reference specific volume         (m3/kg) 
     52   REAL(wp), PUBLIC ::   rcp      =    4.e+3_wp   !: ocean specific heat 
     53   REAL(wp), PUBLIC ::   ro0cpr                   !: = 1. / ( rau0 * rcp ) 
     54 
    5755#if defined key_lim3 
    58       rcdsn   =   0.31_wp     ,   &  !: thermal conductivity of snow 
    59       rcdic   =   2.034396_wp ,   &  !: thermal conductivity of fresh ice 
    60       cpic    = 2067.0        ,   & 
    61       ! add the following lines 
    62       lsub    = 2.834e+6      ,   &  !: pure ice latent heat of sublimation (J.kg-1) 
    63       lfus    = 0.334e+6      ,   &  !: latent heat of fusion of fresh ice   (J.kg-1) 
    64       rhoic   = 917._wp       ,   &  !: volumic mass of sea ice (kg/m3) 
    65       tmut    =   0.054       ,   &  !: decrease of seawater meltpoint with salinity 
     56   REAL(wp), PUBLIC ::   rcdsn   =   0.31_wp      !: thermal conductivity of snow 
     57   REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: thermal conductivity of fresh ice 
     58   REAL(wp), PUBLIC ::   cpic    = 2067.0         !: specific heat of sea ice 
     59   REAL(wp), PUBLIC ::   lsub    = 2.834e+6       !: pure ice latent heat of sublimation (J.kg-1) 
     60   REAL(wp), PUBLIC ::   lfus    = 0.334e+6       !: latent heat of fusion of fresh ice   (J.kg-1) 
     61   REAL(wp), PUBLIC ::   rhoic   = 917._wp        !: volumic mass of sea ice (kg/m3) 
     62   REAL(wp), PUBLIC ::   tmut    =   0.054        !: decrease of seawater meltpoint with salinity 
    6663#else 
    67       rcdsn   =   0.22_wp     ,   &  !: conductivity of the snow 
    68       rcdic   =   2.034396_wp ,   &  !: conductivity of the ice 
    69       rcpsn   =   6.9069e+5_wp,   & !: density times specific heat for snow 
    70       rcpic   =   1.8837e+6_wp,   & !: volumetric latent heat fusion of sea ice 
    71       xlsn    = 110.121e+6_wp ,   &  !: volumetric latent heat fusion of snow 
    72       xlic    = 300.33e+6_wp  ,   &  !: volumetric latent heat fusion of ice 
    73       xsn     =   2.8e+6      ,   &  !: latent heat of sublimation of snow 
    74       rhoic   = 900._wp       ,   &  !: volumic mass of sea ice (kg/m3) 
     64   REAL(wp), PUBLIC ::   rcdsn   =   0.22_wp      !: conductivity of the snow 
     65   REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: conductivity of the ice 
     66   REAL(wp), PUBLIC ::   rcpsn   =   6.9069e+5_wp !: density times specific heat for snow 
     67   REAL(wp), PUBLIC ::   rcpic   =   1.8837e+6_wp !: volumetric latent heat fusion of sea ice 
     68   REAL(wp), PUBLIC ::   xlsn    = 110.121e+6_wp  !: volumetric latent heat fusion of snow 
     69   REAL(wp), PUBLIC ::   xlic    = 300.33e+6_wp   !: volumetric latent heat fusion of ice 
     70   REAL(wp), PUBLIC ::   xsn     =   2.8e+6       !: latent heat of sublimation of snow 
     71   REAL(wp), PUBLIC ::   rhoic   = 900._wp        !: volumic mass of sea ice (kg/m3) 
    7572#endif 
    76       rhosn   = 330._wp       ,   &  !: volumic mass of snow (kg/m3) 
    77       emic    =   0.97_wp     ,   &  !: emissivity of snow or ice 
    78       sice    =   6.0_wp      ,   &  !: salinity of ice (psu) 
    79       soce    =  34.7_wp      ,   &  !: salinity of sea (psu) 
    80       cevap   =   2.5e+6_wp   ,   &  !: latent heat of evaporation (water) 
    81       srgamma =   0.9_wp      ,   &  !: correction factor for solar radiation (Oberhuber, 1974) 
    82       vkarmn  =   0.4_wp      ,   &  !: von Karman constant 
    83       stefan  =   5.67e-8_wp         !: Stefan-Boltzmann constant  
    84       !!---------------------------------------------------------------------- 
    85       !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    86       !! $Id$  
    87       !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    88       !!---------------------------------------------------------------------- 
     73   REAL(wp), PUBLIC ::   rhosn   = 330._wp        !: volumic mass of snow (kg/m3) 
     74   REAL(wp), PUBLIC ::   emic    =   0.97_wp      !: emissivity of snow or ice 
     75   REAL(wp), PUBLIC ::   sice    =   6.0_wp       !: reference salinity of ice (psu) 
     76   REAL(wp), PUBLIC ::   soce    =  34.7_wp       !: reference salinity of sea (psu) 
     77   REAL(wp), PUBLIC ::   cevap   =   2.5e+6_wp    !: latent heat of evaporation (water) 
     78   REAL(wp), PUBLIC ::   srgamma =   0.9_wp       !: correction factor for solar radiation (Oberhuber, 1974) 
     79   REAL(wp), PUBLIC ::   vkarmn  =   0.4_wp       !: von Karman constant 
     80   REAL(wp), PUBLIC ::   stefan  =   5.67e-8_wp   !: Stefan-Boltzmann constant  
     81   !!---------------------------------------------------------------------- 
     82   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     83   !! $Id$  
     84   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     85   !!---------------------------------------------------------------------- 
    8986    
    9087CONTAINS 
    … …  
    9996      !!---------------------------------------------------------------------- 
    10097 
    101       IF(lwp) WRITE(numout,*) 
    102       IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
    103       IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     98      !                                   ! Define additional parameters 
     99      rsiyea = 365.25 * rday * 2. * rpi / 6.283076 
     100      rsiday = rday / ( 1. + rday / rsiyea ) 
     101      omega  = 2. * rpi / rsiday  
    104102 
    105       ! Ocean Parameters 
    106       ! ---------------- 
    107       IF(lwp) THEN 
     103      rau0r  = 1. /   rau0   
     104      ro0cpr = 1. / ( rau0 * rcp ) 
     105 
     106 
     107      IF(lwp) THEN                        ! control print 
     108         WRITE(numout,*) 
     109         WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
     110         WRITE(numout,*) ' ~~~~~~~' 
    108111         WRITE(numout,*) '       Domain info' 
    109112         WRITE(numout,*) '          dimension of model' 
    … …  
    118121         WRITE(numout,*) '             jpnij   : ', jpnij 
    119122         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio 
    120       ENDIF 
    121  
    122       ! Define constants 
    123       ! ---------------- 
    124       IF(lwp) WRITE(numout,*) 
    125       IF(lwp) WRITE(numout,*) '       Constants' 
    126  
    127       IF(lwp) WRITE(numout,*) 
    128       IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi 
    129  
    130       rsiyea = 365.25 * rday * 2. * rpi / 6.283076 
    131       rsiday = rday / ( 1. + rday / rsiyea ) 
    132       omega  = 2. * rpi / rsiday  
    133       IF(lwp) WRITE(numout,*) 
    134       IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
    135       IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s' 
    136       IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
    137       IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1' 
    138  
    139       IF(lwp) WRITE(numout,*) 
    140       IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
    141       IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
    142       IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
    143       IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
    144  
    145       IF(lwp) WRITE(numout,*) 
    146       IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m' 
    147       IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
    148  
    149       IF(lwp) WRITE(numout,*) 
    150       IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
    151       IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
    152       IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
    153       IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
    154  
    155       ro0cpr = 1. / ( rau0 * rcp ) 
    156       IF(lwp) WRITE(numout,*) 
    157       IF(lwp) WRITE(numout,*) '          volumic mass of pure water         rauw   = ', rauw, ' kg/m^3' 
    158       IF(lwp) WRITE(numout,*) '          volumic mass of reference          rau0   = ', rau0, ' kg/m^3' 
    159       IF(lwp) WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp 
    160       IF(lwp) WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 
    161  
    162       IF(lwp) THEN 
     123         WRITE(numout,*) 
     124         WRITE(numout,*) '       Constants' 
     125         WRITE(numout,*) 
     126         WRITE(numout,*) '          mathematical constant                 rpi = ', rpi 
     127         WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
     128         WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s' 
     129         WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
     130         WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1' 
     131         WRITE(numout,*) 
     132         WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
     133         WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
     134         WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
     135         WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
     136         WRITE(numout,*) 
     137         WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m' 
     138         WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
     139         WRITE(numout,*) 
     140         WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
     141         WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
     142         WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
     143         WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
     144         WRITE(numout,*) 
     145         WRITE(numout,*) '          ocean reference volumic mass       rau0   = ', rau0 , ' kg/m^3' 
     146         WRITE(numout,*) '          ocean reference specific volume    rau0r  = ', rau0r, ' m^3/Kg' 
     147         WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp 
     148         WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 
    163149         WRITE(numout,*) 
    164150         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    … …  
    184170         WRITE(numout,*) '          von Karman constant                       = ', vkarmn  
    185171         WRITE(numout,*) '          Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4' 
    186  
    187172         WRITE(numout,*) 
    188173         WRITE(numout,*) '          conversion: degre ==> radian          rad = ', rad 
    189  
    190174         WRITE(numout,*) 
    191175         WRITE(numout,*) '          smallest real computer value       rsmall = ', rsmall 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r1152 r2007  
    123123 
    124124#if defined key_obc 
    125 #if defined key_agrif 
    126          IF (Agrif_Root() ) THEN 
    127 #endif 
    128          ! open boundaries (div must be zero behind the open boundary) 
    129          !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    130          IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    131          IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    132          IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    133          IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    134 #if defined key_agrif 
    135          ENDIF 
    136 #endif 
     125         IF( Agrif_Root() ) THEN 
     126            ! open boundaries (div must be zero behind the open boundary) 
     127            !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
     128            IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
     129            IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
     130            IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
     131            IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
     132         ENDIF 
    137133#endif          
    138134#if defined key_bdy 
    139135         ! unstructured open boundaries (div must be zero behind the open boundary) 
    140136         DO jj = 1, jpj 
    141            DO ji = 1, jpi 
    142              hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj) 
    143            END DO 
     137            DO ji = 1, jpi 
     138               hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj) 
     139            END DO 
    144140         END DO 
    145141#endif          
    146 #if defined key_agrif 
    147          if ( .NOT. AGRIF_Root() ) then 
    148            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
    149            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
    150            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
    151            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
    152          endif 
    153 #endif     
     142         IF( .NOT. AGRIF_Root() ) THEN 
     143            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
     144            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
     145            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
     146            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
     147         ENDIF 
    154148 
    155149         !                                             ! -------- 
    … …  
    341335 
    342336#if defined key_obc 
    343 #if defined key_agrif 
    344          IF ( Agrif_Root() ) THEN 
    345 #endif 
    346          ! open boundaries (div must be zero behind the open boundary) 
    347          !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    348          IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    349          IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    350          IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    351          IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    352 #if defined key_agrif 
    353          ENDIF 
    354 #endif 
     337         IF( Agrif_Root() ) THEN 
     338            ! open boundaries (div must be zero behind the open boundary) 
     339            !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
     340            IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
     341            IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
     342            IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
     343            IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
     344         ENDIF 
    355345#endif          
    356346#if defined key_bdy 
    … …  
    362352         END DO 
    363353#endif         
    364 #if defined key_agrif 
    365          if ( .NOT. AGRIF_Root() ) then 
     354         IF( .NOT. AGRIF_Root() ) THEN 
    366355            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
    367356            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
    368357            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
    369358            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
    370          endif 
    371 #endif     
     359         ENDIF 
    372360 
    373361         !                                             ! -------- 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r1740 r2007  
    146146# if defined key_obc 
    147147      !                                !* OBC open boundaries 
    148       CALL obc_dyn( kt ) 
     148      IF( lk_obc )   CALL obc_dyn( kt ) 
    149149      ! 
    150150      IF ( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r1739 r2007  
    186186 
    187187#if defined key_obc 
    188       CALL obc_dyn( kt )      ! Update velocities on each open boundary with the radiation algorithm 
    189       CALL obc_vol( kt )      ! Correction of the barotropic componant velocity to control the volume of the system 
     188      IF( lk_obc )   CALL obc_dyn( kt )   ! Update velocities on each open boundary with the radiation algorithm 
     189      IF( lk_obc )   CALL obc_vol( kt )   ! Correction of the barotropic componant velocity to control the volume of the system 
    190190#endif 
    191191#if defined key_bdy 
    … …  
    315315#if defined key_obc 
    316316            ! caution : grad D = 0 along open boundaries 
    317             spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
    318             spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
     317            IF( Agrif_Root() ) THEN 
     318               spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
     319               spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
     320            ELSE 
     321               spgu(ji,jj) = z2dt * ztdgu 
     322               spgv(ji,jj) = z2dt * ztdgv 
     323            ENDIF 
    319324#elif defined key_bdy 
    320325            ! caution : grad D = 0 along open boundaries 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r1756 r2007  
    157157 
    158158#if defined key_obc 
    159 # if defined key_agrif 
    160159      IF ( Agrif_Root() ) THEN  
    161 # endif 
    162160         ssha(:,:) = ssha(:,:) * obctmsk(:,:) 
    163161         CALL lbc_lnk( ssha, 'T', 1. )  ! absolutly compulsory !! (jmm) 
    164 # if defined key_agrif 
    165       ENDIF 
    166 # endif 
     162      ENDIF 
    167163#endif 
    168164 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r1743 r2007  
    4343   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag 
    4444#endif 
    45    PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
     45   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    4646 
    4747   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    … …  
    8686      !!---------------------------------------------------------------------- 
    8787      ! read the xml file 
    88       CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)... 
     88      IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)... 
     89      CALL iom_swap 
    8990 
    9091      ! calendar parameters 
    … …  
    119120 
    120121   END SUBROUTINE iom_init 
     122 
     123 
     124   SUBROUTINE iom_swap 
     125      !!--------------------------------------------------------------------- 
     126      !!                   ***  SUBROUTINE  iom_swap  *** 
     127      !! 
     128      !! ** Purpose :  swap context between different agrif grid for xmlio_server 
     129      !!--------------------------------------------------------------------- 
     130#if defined key_iomput 
     131 
     132     IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
     133        CALL event__swap_context("nemo") 
     134     ELSE 
     135        CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo") 
     136     ENDIF 
     137 
     138#endif 
     139   END SUBROUTINE iom_swap 
    121140 
    122141 
    … …  
    164183      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0 
    165184      ! (could be done when defining iom_file in f95 but not in f90) 
    166 #if ! defined key_agrif 
    167       IF( iom_open_init == 0 ) THEN 
    168          iom_file(:)%nfid = 0 
    169          iom_open_init = 1 
    170       ENDIF 
    171 #else 
    172185      IF( Agrif_Root() ) THEN 
    173186         IF( iom_open_init == 0 ) THEN 
    … …  
    176189         ENDIF 
    177190      ENDIF 
    178 #endif 
    179191      ! do we read or write the file? 
    180192      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt 
    … …  
    199211      ! ============= 
    200212      clname   = trim(cdname) 
    201 #if defined key_agrif 
    202213      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 
    203214         iln    = INDEX(clname,'/')  
    … …  
    206217         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    207218      ENDIF 
    208 #endif     
    209219      ! which suffix should we use? 
    210220      SELECT CASE (iolib) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90

    r1601 r2007  
    2727   ! 
    2828   !                                  !!* Namelist namobc: open boundary condition * 
    29    INTEGER           ::   nn_nbobc    = 2        !: number of open boundaries ( 1=< nbobc =< 4 )  
    3029   INTEGER           ::   nn_obcdta   = 0        !:  = 0 use the initial state as obc data 
    3130   !                                             !   = 1 read obc data in obcxxx.dta files 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90

    r1647 r2007  
    2525   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    2626   !!---------------------------------------------------------------------- 
    27    LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.   !: Ocean Boundary Condition flag 
     27#if ! defined key_agrif 
     28   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.     !: Ocean Boundary Condition flag 
     29#else 
     30   LOGICAL, PUBLIC            ::   lk_obc = .TRUE.     !: Ocean Boundary Condition flag 
     31#endif 
    2832 
    2933# if defined key_eel_r5 
    … …  
    4347   !! open boundary parameter 
    4448   !!--------------------------------------------------------------------- 
    45    INTEGER, PARAMETER ::     &  !: time dimension of the BCS fields on input 
     49   INTEGER ::     &  !: time dimension of the BCS fields on input 
    4650      jptobc  =         2  
    4751   !! * EAST open boundary 
    48    LOGICAL, PARAMETER ::     &  !: 
     52   LOGICAL ::     &  !: 
    4953      lp_obc_east = .FALSE.     !: to active or not the East open boundary 
    50    INTEGER, PARAMETER ::     &  !: 
     54   INTEGER ::     &  
    5155      jpieob  = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
    5256      jpjed   =        2,    &  !: j-starting indice of the East open boundary (must be land T-point) 
    … …  
    5660 
    5761   !! * WEST open boundary 
    58    LOGICAL, PARAMETER ::     &  !: 
     62   LOGICAL ::     &  !: 
    5963      lp_obc_west = .FALSE.     !: to active or not the West open boundary 
    60    INTEGER, PARAMETER ::     &  !: 
     64   INTEGER ::     &  !: 
    6165      jpiwob  =          2,    &  !: i-localization of the West open boundary (must be ocean U-point) 
    6266      jpjwd   =          2,    &  !: j-starting indice of the West open boundary (must be land T-point) 
    … …  
    6670 
    6771   !! * NORTH open boundary 
    68    LOGICAL, PARAMETER ::     &  !: 
     72   LOGICAL ::     &  !: 
    6973      lp_obc_north = .FALSE.    !: to active or not the North open boundary 
    70    INTEGER, PARAMETER ::     &  !: 
     74   INTEGER ::     &  !: 
    7175      jpjnob  = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
    7276      jpind   =        2,    &  !: i-starting indice of the North open boundary (must be land T-point) 
    … …  
    7680 
    7781   !! * SOUTH open boundary 
    78    LOGICAL, PARAMETER ::     &  !: 
     82   LOGICAL ::     &  !: 
    7983      lp_obc_south = .FALSE.    !: to active or not the South open boundary 
    80    INTEGER, PARAMETER ::     &  !: 
     84   INTEGER ::     &  !: 
    8185      jpjsob  =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
    8286      jpisd   =        2,    &  !: i-starting indice of the South open boundary (must be land T-point) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90

    r1152 r2007  
    1515   LOGICAL, PARAMETER ::     &  !: 
    1616      lp_obc_east = .TRUE.      !: to active or not the East open boundary 
    17    INTEGER, PARAMETER ::     &  !: 
     17 
     18     INTEGER   & 
     19#if !defined key_agrif 
     20     , PARAMETER   & 
     21#endif 
     22    ::     & 
    1823      jpieob  = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
    1924      jpjed   =        2,    &  !: j-starting indice of the East open boundary (must be land T-point) 
    … …  
    2530   LOGICAL, PARAMETER ::     &  !: 
    2631      lp_obc_west = .TRUE.      !: to active or not the West open boundary 
    27    INTEGER, PARAMETER ::     & 
     32 
     33     INTEGER   & 
     34#if !defined key_agrif 
     35     , PARAMETER   & 
     36#endif 
     37    ::     & 
    2838      jpiwob  =          2,    &  !: i-localization of the West open boundary (must be ocean U-point) 
    2939      jpjwd   =          2,    &  !: j-starting indice of the West open boundary (must be land T-point) 
    … …  
    3545   LOGICAL, PARAMETER ::     &  !: 
    3646      lp_obc_north = .FALSE.    !: to active or not the North open boundary 
    37    INTEGER, PARAMETER ::     &  !: 
     47 
     48     INTEGER   & 
     49#if !defined key_agrif 
     50     , PARAMETER   & 
     51#endif 
     52    ::     & 
    3853      jpjnob  = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
    3954      jpind   =        2,    &  !: i-starting indice of the North open boundary (must be land T-point) 
    … …  
    4560   LOGICAL, PARAMETER ::     &  !: 
    4661      lp_obc_south = .FALSE.    !: to active or not the South open boundary 
    47    INTEGER, PARAMETER ::     &  !: 
     62 
     63     INTEGER   & 
     64#if !defined key_agrif 
     65     , PARAMETER   & 
     66#endif 
     67    ::     & 
    4868      jpjsob  =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
    4969      jpisd   =        2,    &  !: i-starting indice of the South open boundary (must be land T-point) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_POMME_R025.h90

    r1648 r2007  
    44   !! open boundary parameter : POMME configuration 
    55   !!--------------------------------------------------------------------- 
    6      INTEGER, PARAMETER ::     &  !: time dimension of the BCS fields on input 
    7       jptobc  =         14 
     6   INTEGER, PARAMETER ::  jptobc  =       14    
     7   !: time dimension of the BCS fields on input 
    88 
    99   !! * EAST open boundary 
    1010   LOGICAL, PARAMETER ::     &  !: 
    1111      lp_obc_east = .TRUE.      !: 
    12    INTEGER, PARAMETER ::     &  !: 
    1312 
     13     INTEGER   & 
     14#if !defined key_agrif 
     15     , PARAMETER   &  
     16#endif 
     17    ::     &  
    1418      ! * default values * 
    1519      !jpieob = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
    1620      !jpjed  =        2,    &  !: j-starting indice of the East open boundary (must be land T-point) 
    1721      !jpjef  = jpjglo-1,    &  !: j-ending   indice of the East open boundary (must be land T-point) 
    18  
    1922      jpieob = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
    2023      jpjed  =        1,    &  !: j-starting indice of the East open boundary (must be land T-point) 
    2124      jpjef  =   jpjglo,    &  !: j-ending   indice of the East open boundary (must be land T-point) 
    22  
    2325      jpjedp1 =  jpjed+1,    &  !: first ocean point         "                 " 
    2426      jpjefm1 =  jpjef-1        !: last  ocean point         "                 " 
    … …  
    2729   LOGICAL, PARAMETER ::     &  !: 
    2830      lp_obc_west = .TRUE.     !: to active or not the West open boundary 
    29    INTEGER, PARAMETER ::     &  !: 
    3031 
     32     INTEGER   & 
     33#if !defined key_agrif 
     34     , PARAMETER   &  
     35#endif 
     36    ::     &  
    3137      ! * default values * 
    3238      !jpiwob  =        2,   &  !: i-localization of the West open boundary (must be ocean U-point) 
    3339      !jpjwd   =        2,   &  !: j-starting indice of the West open boundary (must be land T-point) 
    3440      !jpjwf   = jpjglo-1,   &  !: j-ending   indice of the West open boundary (must be land T-point) 
    35  
    3641      jpiwob  =        2,   &  !: i-localization of the West open boundary (must be ocean U-point) 
    3742      jpjwd   =        1,   &  !: j-starting indice of the West open boundary (must be land T-point) 
    3843      jpjwf   =   jpjglo,   &  !: j-ending   indice of the West open boundary (must be land T-point) 
    39  
    4044      jpjwdp1 =  jpjwd+1,    &  !: first ocean point         "                 " 
    4145      jpjwfm1 =  jpjwf-1        !: last  ocean point         "                 " 
    … …  
    4448   LOGICAL, PARAMETER ::     &  !: 
    4549      lp_obc_north = .TRUE.     !: 
    46    INTEGER, PARAMETER ::     &  !: 
    4750 
     51     INTEGER   & 
     52#if !defined key_agrif 
     53     , PARAMETER   &  
     54#endif 
     55    ::     &  
    4856      ! * default values * 
    4957      !jpjnob = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
    5058      !jpind  =        2,    &  !: i-starting indice of the North open boundary (must be land T-point) 
    5159      !jpinf  = jpiglo-1,    &  !: i-ending   indice of the North open boundary (must be land T-point) 
    52  
    5360      jpjnob = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
    5461      jpind  =        1,    &  !: i-starting indice of the North open boundary (must be land T-point) 
    5562      jpinf  =   jpiglo,    &  !: i-ending   indice of the North open boundary (must be land T-point) 
    56  
    5763      jpindp1 =  jpind+1,    &  !: first ocean point         "                 " 
    5864      jpinfm1 =  jpinf-1        !: last  ocean point         "                 " 
    … …  
    6167   LOGICAL, PARAMETER ::     &  !: 
    6268      lp_obc_south = .TRUE.     !: INDICE to active or not the South open boundary 
    63    INTEGER, PARAMETER ::     &  !: 
    6469 
     70     INTEGER   & 
     71#if !defined key_agrif 
     72     , PARAMETER   &  
     73#endif 
     74    ::     &  
    6575      ! * default values * 
    6676      !jpjsob =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
    6777      !jpisd  =        2,    &  !: i-starting indice of the South open boundary (must be land T-point) 
    6878      !jpisf  = jpiglo-1,    &  !: i-ending   indice of the South open boundary (must be land T-point) 
    69  
    7079      jpjsob =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
    7180      jpisd  =        1,    &  !: i-starting indice of the South open boundary (must be land T-point) 
    7281      jpisf  =   jpiglo,    &  !: i-ending   indice of the South open boundary (must be land T-point) 
    73  
    7482      jpisdp1 =  jpisd+1,    &  !: first ocean point         "                 " 
    7583      jpisfm1 =  jpisf-1        !: last  ocean point         "                 " 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90

    r1732 r2007  
    469469       ENDIF 
    470470    ELSE 
     471#if defined key_agrif 
     472       IF ( ASSOCIATED(ztcobc) ) DEALLOCATE ( ztcobc ) 
     473#else 
    471474       IF ( ALLOCATED(ztcobc) ) DEALLOCATE ( ztcobc ) 
     475#endif 
    472476       ALLOCATE (ztcobc(itobc)) 
    473477       DO ji=1,1   ! use a dummy loop to read ztcobc only once 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90

    r1152 r2007  
    8282 
    8383      DO ji = nie0, nie1 
    84          DO jk = 1, jpkm1 
    85             DO jj = 1, jpj 
    86                ua_e(ji,jj) = (  ubtfoe(jj) + sqrt( grav*hu(ji,jj) )           & 
    87                   &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5  & 
    88                   &            - sshfoe(jj) )  ) * uemsk(jj,jk) 
    89             END DO 
     84         DO jj = 1, jpj 
     85            ua_e(ji,jj) = (  ubtfoe(jj) * hur(ji,jj) + sqrt( grav*hur(ji,jj) )   & 
     86               &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5        & 
     87               &            - sshfoe(jj) )  ) * uemsk(jj,jk) 
    9088         END DO 
    9189      END DO 
    … …  
    9795            ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - temsk(jj,1) ) & 
    9896               &            + temsk(jj,1) * sshfoe(jj) 
    99             va_e(ji,jj) = vbtfoe(jj) * uemsk(jj,jk) 
     97            va_e(ji,jj) = vbtfoe(jj) * hvr(ji,jj) * uemsk(jj,jk) 
    10098         END DO 
    10199      END DO 
    … …  
    120118 
    121119      DO ji = niw0, niw1 
    122          DO jk = 1, jpkm1 
    123             DO jj = 1, jpj 
    124                ua_e(ji,jj) = ( ubtfow(jj) - sqrt( grav * hu(ji,jj) )          & 
    125                   &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5  & 
    126                   &                - sshfow(jj) ) ) * uwmsk(jj,jk) 
    127                va_e(ji,jj) = vbtfow(jj) * uwmsk(jj,jk) 
    128             END DO 
     120         DO jj = 1, jpj 
     121            ua_e(ji,jj) = ( ubtfow(jj) * hur(ji,jj) - sqrt( grav * hur(ji,jj) )   & 
     122               &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5         & 
     123               &                - sshfow(jj) ) ) * uwmsk(jj,jk) 
     124            va_e(ji,jj) = vbtfow(jj) * hvr(ji,jj) * uwmsk(jj,jk) 
    129125         END DO 
    130126         DO jj = 1, jpj 
    … …  
    155151 
    156152      DO jj = njn0, njn1 
    157          DO jk = 1, jpkm1 
    158             DO ji = 1, jpi 
    159                va_e(ji,jj) = ( vbtfon(ji) + sqrt( grav * hv(ji,jj) )           & 
    160                   &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5   & 
    161                   &                - sshfon(ji) ) ) * vnmsk(ji,jk) 
    162             END DO 
     153         DO ji = 1, jpi 
     154            va_e(ji,jj) = ( vbtfon(ji) * hvr(ji,jj) + sqrt( grav * hvr(ji,jj) )   & 
     155               &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5         & 
     156               &                - sshfon(ji) ) ) * vnmsk(ji,jk) 
    163157         END DO 
    164158      END DO 
    … …  
    170164            ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - tnmsk(ji,1) ) & 
    171165               &            + sshfon(ji) * tnmsk(ji,1) 
    172             ua_e(ji,jj) = ubtfon(ji) * vnmsk(ji,jk) 
     166            ua_e(ji,jj) = ubtfon(ji) * hur(ji,jj) * vnmsk(ji,jk) 
    173167         END DO 
    174168      END DO 
    … …  
    193187 
    194188      DO jj = njs0, njs1 
    195          DO jk = 1, jpkm1 
    196             DO ji = 1, jpi 
    197                va_e(ji,jj) = ( vbtfos(ji) - sqrt( grav * hv(ji,jj) )            & 
    198                   &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5    & 
    199                   &                - sshfos(ji) ) ) * vsmsk(ji,jk) 
    200                ua_e(ji,jj) = ubtfos(ji) * vsmsk(ji,jk) 
    201             END DO 
     189         DO ji = 1, jpi 
     190            va_e(ji,jj) = ( vbtfos(ji) * hvr(ji,jj) - sqrt( grav * hvr(ji,jj) )   & 
     191               &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5         & 
     192               &                - sshfos(ji) ) ) * vsmsk(ji,jk) 
     193            ua_e(ji,jj) = ubtfos(ji) * hur(ji,jj) * vsmsk(ji,jk) 
    202194         END DO 
    203195         DO ji = 1, jpi 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90

    r1633 r2007  
    7070 
    7171      ! convert DOCTOR namelist name into the OLD names 
    72       nbobc    = nn_nbobc 
    7372      nobc_dta = nn_obcdta 
    7473      cffile   = cn_obcdta 
    … …  
    101100      IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries' 
    102101      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    103       IF(lwp) WRITE(numout,*) '   Number of open boundaries    nn_nbobc = ', nn_nbobc 
     102      IF(lwp) WRITE(numout,*) '   Number of open boundaries    nbobc = ', nbobc 
    104103      IF(lwp) WRITE(numout,*) 
    105104 
    … …  
    306305      IF( lp_obc_east ) THEN 
    307306         !... (jpjed,jpjefm1),jpieob 
     307         bmask(nie0p1:nie1p1,nje0:nje1m1) = 0.e0 
    308308 
    309309         ! ... initilization to zero 
    … …  
    341341      IF( lp_obc_north ) THEN 
    342342         ! ... jpjnob,(jpind,jpisfm1) 
     343         bmask(nin0:nin1m1,njn0p1:njn1p1) = 0.e0 
    343344 
    344345         ! ... initilization to zero 
    … …  
    440441            END DO 
    441442         END IF 
    442    
     443 
    443444         IF( lp_obc_north ) THEN ! ... North open boundary lateral surface 
    444445            DO jj = njn0, njn1 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90

    r1715 r2007  
    9696         ! ------------- 
    9797 
    98          CALL ctl_opn( inum, 'restart.obc.output', 'REPLACE', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 
     98         CALL ctl_opn( inum, 'restart.obc.output', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 
    9999  
    100100         ! 1.2 Write header 
    … …  
    322322      ! 0.1 Open files 
    323323      ! --------------- 
    324       CALL ctl_opn( inum, 'restart.obc', 'REPLACE', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 
     324      CALL ctl_opn( inum, 'restart.obc', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 
    325325 
    326326      ! 1. Read 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r1730 r2007  
    184184                        &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop ) 
    185185 
    186                      IF( sd(jf)%num == 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist 
     186                     IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist 
    187187                        CALL ctl_warn('next year/month/day file: '//TRIM(sd(jf)%clname)//     & 
    188188                                &     ' not present -> back to current year/month/day') 
    … …  
    368368          
    369369         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    370          IF( llprev .AND. sdjf%num == 0 ) THEN 
     370         IF( llprev .AND. sdjf%num <= 0 ) THEN 
    371371            CALL ctl_warn( 'previous year/month/day file: '//TRIM(sdjf%clname)//' not present -> back to current year/month/day') 
    372372            ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day 
    … …  
    399399      ENDIF 
    400400 
    401       IF( sdjf%num == 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
     401      IF( sdjf%num <= 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
    402402 
    403403      sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read  
    … …  
    815815            WRITE(aname,'(a3,i2.2)') 'src',jn 
    816816            data_tmp(:,:) = 0 
    817             CALL iom_get ( inum, jpdom_unknown, aname, data_tmp(1:nlci,1:nlcj), & 
    818                            kstart=(/nimpp,njmpp/), kcount=(/nlci,nlcj/) ) 
     817            CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) ) 
    819818            data_src(:,:) = INT(data_tmp(:,:)) 
    820819            ref_wgts(nxt_wgt)%data_jpj(:,:,jn) = 1 + (data_src(:,:)-1) / ref_wgts(nxt_wgt)%ddims(1) 
    … …  
    825824            aname = ' ' 
    826825            WRITE(aname,'(a3,i2.2)') 'wgt',jn 
    827             ref_wgts(nxt_wgt)%data_wgt(1:nlci,1:nlcj,jn) = 0.0 
    828             CALL iom_get ( inum, jpdom_unknown, aname, ref_wgts(nxt_wgt)%data_wgt(1:nlci,1:nlcj,jn), & 
    829                            kstart=(/nimpp,njmpp/), kcount=(/nlci,nlcj/) ) 
     826            ref_wgts(nxt_wgt)%data_wgt(:,:,jn) = 0.0 
     827            CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) ) 
    830828         END DO 
    831829         CALL iom_close (inum) 
    832830  
    833831         ! find min and max indices in grid 
    834          ref_wgts(nxt_wgt)%botleft(1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(1:nlci,1:nlcj,:)) 
    835          ref_wgts(nxt_wgt)%botleft(2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(1:nlci,1:nlcj,:)) 
    836          ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi(1:nlci,1:nlcj,:)) 
    837          ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj(1:nlci,1:nlcj,:)) 
     832         ref_wgts(nxt_wgt)%botleft(1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 
     833         ref_wgts(nxt_wgt)%botleft(2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 
     834         ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 
     835         ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 
    838836 
    839837         ! and therefore dimensions of the input box 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r1613 r2007  
    311311 
    312312      ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 
    313       CALL lbc_lnk( gcost, 'T', 1. )   ;   CALL lbc_lnk( gsint, 'T', -1. ) 
    314       CALL lbc_lnk( gcosu, 'U', 1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. ) 
    315       CALL lbc_lnk( gcosv, 'V', 1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. ) 
    316       CALL lbc_lnk( gcosf, 'F', 1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. ) 
     313      CALL lbc_lnk( gcost, 'T', -1. )   ;   CALL lbc_lnk( gsint, 'T', -1. ) 
     314      CALL lbc_lnk( gcosu, 'U', -1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. ) 
     315      CALL lbc_lnk( gcosv, 'V', -1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. ) 
     316      CALL lbc_lnk( gcosf, 'F', -1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. ) 
    317317 
    318318   END SUBROUTINE angle 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r1766 r2007  
    2323   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2424   USE sbc_ice         ! Surface boundary condition: ice fields 
     25   USE phycst          ! physical constants 
    2526#if defined key_lim3 
    2627   USE par_ice         ! ice parameters 
    … …  
    4546   USE lib_mpp         ! distribued memory computing library 
    4647   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    47    USE phycst, ONLY : xlsn, rhosn, xlic, rhoic 
    4848#if defined key_cpl_carbon_cycle 
    4949   USE p4zflx, ONLY : oce_co2 
    … …  
    274274      srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     -  
    275275      !  
    276       srcv(jpr_otx1:jpr_itz2)%nsgn = -1                           ! Vectors: change of sign at north fold 
     276      ! Vectors: change of sign at north fold ONLY if on the local grid 
     277      IF( TRIM( cn_rcv_tau(3) ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
    277278       
    278279      !                                                           ! Set grid and action 
    … …  
    714715         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(:,:,jpr_qnsoce) 
    715716         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(:,:,jpr_qnsmix)         
    716          !   energy for melting solid precipitation over free ocean 
    717          zcoef = xlsn / rhosn 
    718          qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * zcoef 
     717         qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * lfus              ! add the latent heat of solid precip. melting  
     718 
    719719         !                                                       ! solar flux over the ocean          (qsr) 
    720720         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(:,:,jpr_qsroce)  
    … …  
    11171117            &                                                   +          pist(:,:,1)   * zicefr(:,:,1) ) ) 
    11181118      END SELECT 
    1119       !                                                           ! snow melting heat flux .... 
    1120       !   energy for melting solid precipitation over ice-free ocean 
    1121       zcoef = xlsn / rhosn 
    1122       ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * zcoef 
    1123       pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 
     1119      ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * lfus               ! add the latent heat of solid precip. melting 
     1120      pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)                   ! over free ocean  
    11241121      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    11251122!!gm 
    … …  
    11301127!! 
    11311128!! similar job should be done for snow and precipitation temperature 
    1132       !                                                           ! Iceberg melting heat flux .... 
    1133       !   energy for iceberg melting  
    1134       IF( srcv(jpr_cal)%laction ) THEN  
    1135          zcoef = xlic / rhoic 
    1136          ztmp(:,:) = frcv(:,:,jpr_cal) * zcoef 
     1129      !                                      
     1130      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
     1131         ztmp(:,:) = frcv(:,:,jpr_cal) * lfus                     ! add the latent heat of iceberg melting  
    11371132         pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 
    11381133         IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(:,:,jpr_cal) * zcptn(:,:) )   ! heat flux from calving 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r1715 r2007  
    6565      INTEGER  ::   inum                  ! temporary logical unit 
    6666      INTEGER  ::   ikty, iyear           !  
    67       REAL(wp) ::   z_emp, z_emp_nsrf       ! temporary scalars 
     67      REAL(wp) ::   z_emp, z_emp_nsrf, zsum_emp, zsum_erp       ! temporary scalars 
    6868      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread 
    6969      REAL(wp), DIMENSION(jpi,jpj) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread 
    … …  
    165165            ! 
    166166            IF( lk_mpp )   CALL  mpp_sum( z_emp ) 
     167            IF( lk_mpp )   CALL  mpp_sum( zsurf_neg ) 
     168            IF( lk_mpp )   CALL  mpp_sum( zsurf_pos ) 
    167169             
    168170            IF( z_emp < 0.e0 ) THEN 
    … …  
    177179 
    178180            ! emp global mean over <0 or >0 erp area 
    179             z_emp_nsrf = SUM( e1e2_i(:,:) * z_emp ) / ( zsurf_tospread + rsmall ) 
     181            zsum_emp = SUM( e1e2_i(:,:) * z_emp ) 
     182            IF( lk_mpp )   CALL  mpp_sum( zsum_emp ) 
     183            z_emp_nsrf =  zsum_emp / ( zsurf_tospread + rsmall ) 
    180184            ! weight to respect erp field 2D structure  
    181             z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) + rsmall ) 
     185            zsum_erp = SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) 
     186            IF( lk_mpp )   CALL  mpp_sum( zsum_erp ) 
     187            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
     188 
    182189            ! final correction term to apply 
    183190            zerp_cor(:,:) = -1. * z_emp_nsrf * zsurf_tospread * z_wgt(:,:) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r1725 r2007  
    8585!!gm here no overwrite, test all option via namelist change: require more incore memory 
    8686!!gm  IF( lk_sbc_cpl       ) THEN   ;   ln_cpl      = .TRUE.   ;   ELSE   ;   ln_cpl      = .FALSE.   ;   ENDIF 
    87 #if defined key_agrif 
     87 
    8888      IF ( Agrif_Root() ) THEN 
    89 #endif 
    9089        IF( lk_lim2 )            nn_ice      = 2 
    9190        IF( lk_lim3 )            nn_ice      = 3 
    92 #if defined key_agrif 
    93       ENDIF 
    94 #endif 
     91      ENDIF 
     92      ! 
    9593      IF( cp_cfg == 'gyre' ) THEN 
    9694          ln_ana      = .TRUE.    

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

    r1601 r2007  
    9999       
    100100#  elif defined key_dynspg_flt && defined key_obc 
    101  
    102       DO jj = 2, jpjm1                      ! matrix of free surface elliptic system with open boundaries 
    103          DO ji = 2, jpim1 
    104             zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
    105             !                                    ! south coefficient 
    106             IF( lp_obc_south .AND. ( jj == njs0p1 ) ) THEN 
    107                zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vsmsk(ji,1)) 
    108             ELSE 
    109                zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
    110             END IF 
    111             gcp(ji,jj,1) = zcoefs 
    112             ! 
    113             !                                    ! west coefficient 
    114             IF( lp_obc_west  .AND. ( ji == niw0p1 ) ) THEN 
    115                zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-uwmsk(jj,1)) 
    116             ELSE 
    117                zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
    118             END IF 
    119             gcp(ji,jj,2) = zcoefw 
    120             ! 
    121             !                                    ! east coefficient 
    122             IF( lp_obc_east  .AND. ( ji == nie0 ) ) THEN 
    123                zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-uemsk(jj,1)) 
    124             ELSE 
    125                zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
    126             END IF 
    127             gcp(ji,jj,3) = zcoefe 
    128             ! 
    129             !                                    ! north coefficient 
    130             IF( lp_obc_north .AND. ( jj == njn0 ) ) THEN 
    131                zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vnmsk(ji,1)) 
    132             ELSE 
     101      IF( Agrif_Root() ) THEN 
     102         DO jj = 2, jpjm1                      ! matrix of free surface elliptic system with open boundaries 
     103            DO ji = 2, jpim1 
     104               zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
     105               !                                    ! south coefficient 
     106               IF( lp_obc_south .AND. ( jj == njs0p1 ) ) THEN 
     107                  zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vsmsk(ji,1)) 
     108               ELSE 
     109                  zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
     110               END IF 
     111               gcp(ji,jj,1) = zcoefs 
     112               ! 
     113               !                                    ! west coefficient 
     114               IF( lp_obc_west  .AND. ( ji == niw0p1 ) ) THEN 
     115                  zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-uwmsk(jj,1)) 
     116               ELSE 
     117                  zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
     118               END IF 
     119               gcp(ji,jj,2) = zcoefw 
     120               ! 
     121               !                                    ! east coefficient 
     122               IF( lp_obc_east  .AND. ( ji == nie0 ) ) THEN 
     123                  zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-uemsk(jj,1)) 
     124               ELSE 
     125                  zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
     126               END IF 
     127               gcp(ji,jj,3) = zcoefe 
     128               ! 
     129               !                                    ! north coefficient 
     130               IF( lp_obc_north .AND. ( jj == njn0 ) ) THEN 
     131                  zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vnmsk(ji,1)) 
     132               ELSE 
    133133               zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 
    134             END IF 
    135             gcp(ji,jj,4) = zcoefn 
    136             ! 
    137             !                                    ! diagonal coefficient 
    138             gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   & 
    139                &            - zcoefs -zcoefw -zcoefe -zcoefn 
     134               END IF 
     135               gcp(ji,jj,4) = zcoefn 
     136               ! 
     137               !                                    ! diagonal coefficient 
     138               gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   & 
     139                  &            - zcoefs -zcoefw -zcoefe -zcoefn 
     140            END DO 
    140141         END DO 
    141       END DO 
     142      ENDIF 
    142143#endif 
    143144 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r1528 r2007  
    179179      END DO 
    180180 
     181      ! "zonal" mean advective heat and salt transport 
     182      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     183         pht_adv(:) = ptr_vj( ztv(:,:,:) ) 
     184         pst_adv(:) = ptr_vj( zsv(:,:,:) ) 
     185      ENDIF 
    181186 
    182187      ! Save the intermediate i / j / k advective trends for diagnostics 
    … …  
    366371      ! "zonal" mean advective heat and salt transport 
    367372      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    368          pht_adv(:) = ptr_vj( ztv(:,:,:) ) 
    369          pst_adv(:) = ptr_vj( zsv(:,:,:) ) 
     373         pht_adv(:) = ptr_vj( ztv(:,:,:) ) + pht_adv(:) 
     374         pst_adv(:) = ptr_vj( zsv(:,:,:) ) + pst_adv(:) 
    370375      ENDIF 
    371376      ! 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r1601 r2007  
    3838   USE agrif_opa_update 
    3939   USE agrif_opa_interp 
     40   USE obc_oce  
    4041 
    4142   IMPLICIT NONE 
    … …  
    101102      ! 
    102103#if defined key_obc 
    103       CALL obc_tra( kt )               ! OBC open boundaries 
     104      IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries 
    104105#endif 
    105106#if defined key_bdy 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r1739 r2007  
    134134               zta = ro0cpr * qns(ji,jj) * zse3t &                   ! temperature : heat flux 
    135135                &    - emp(ji,jj) * zsrau * tn(ji,jj,1)  * zse3t     ! & cooling/heating effet of EMP flux 
    136                zsa = 0.e0                                            ! No salinity concent./dilut. effect 
     136               zsa = ( emps(ji,jj) - emp(ji,jj) ) & 
     137                &                 * zsrau * sn(ji,jj,1)  * zse3t     ! concent./dilut. effect due to sea-ice  
     138                                                                     ! melt/formation and (possibly) SSS restoration 
    137139            ELSE 
    138140               zta = ro0cpr * qns(ji,jj) * zse3t     ! temperature : heat flux 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/lib_mpp.F90

    r1987 r2007  
    103103   !! ========================= !! 
    104104!$AGRIF_DO_NOT_TREAT 
    105    INCLUDE 'mpif.h' 
     105   INCLUDE mpif.h 
    106106!$AGRIF_END_DO_NOT_TREAT 
    107107    
    … …  
    112112   INTEGER ::   mppsize        ! number of process 
    113113   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ] 
    114    INTEGER ::   mpi_comm_opa   ! opa local communicator 
     114!$AGRIF_DO_NOT_TREAT 
     115   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator 
     116!$AGRIF_END_DO_NOT_TREAT 
    115117 
    116118   ! variables used in case of sea-ice 
    … …  
    191193      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer 
    192194 
    193 #if defined key_agrif 
    194       IF( Agrif_Root() ) THEN 
    195 #endif 
    196          !!bug RB : should be clean to use Agrif in coupled mode 
    197 #if ! defined key_agrif 
    198          CALL mpi_initialized ( mpi_was_called, code ) 
    199          IF( code /= MPI_SUCCESS ) THEN 
    200             WRITE(*, cform_err) 
    201             WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
    202             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    203          ENDIF 
    204  
    205          IF( PRESENT(localComm) .and. mpi_was_called ) THEN 
    206             mpi_comm_opa = localComm 
    207             SELECT CASE ( cn_mpi_send ) 
    208             CASE ( 'S' )                ! Standard mpi send (blocking) 
    209                WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    210             CASE ( 'B' )                ! Buffer mpi send (blocking) 
    211                WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    212                CALL mpi_init_opa( ierr )  
    213             CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    214                WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    215                l_isend = .TRUE. 
    216             CASE DEFAULT 
    217                WRITE(ldtxt(7),cform_err) 
    218                WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    219                nstop = nstop + 1 
    220             END SELECT 
    221          ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
    222             WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
    223             WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
    224             nstop = nstop + 1 
    225          ELSE 
    226 #endif 
    227             SELECT CASE ( cn_mpi_send ) 
    228             CASE ( 'S' )                ! Standard mpi send (blocking) 
    229                WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    230                CALL mpi_init( ierr ) 
    231             CASE ( 'B' )                ! Buffer mpi send (blocking) 
    232                WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    233                CALL mpi_init_opa( ierr ) 
    234             CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    235                WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    236                l_isend = .TRUE. 
    237                CALL mpi_init( ierr ) 
    238             CASE DEFAULT 
    239                WRITE(ldtxt(7),cform_err) 
    240                WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    241                nstop = nstop + 1 
    242             END SELECT 
    243  
    244 #if ! defined key_agrif 
    245             CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
    246             IF( code /= MPI_SUCCESS ) THEN 
    247                WRITE(*, cform_err) 
    248                WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
    249                CALL mpi_abort( mpi_comm_world, code, ierr ) 
    250             ENDIF 
    251             ! 
    252          ENDIF 
    253 #endif 
    254 #if defined key_agrif 
    255       ELSE 
     195      CALL mpi_initialized ( mpi_was_called, code ) 
     196      IF( code /= MPI_SUCCESS ) THEN 
     197         WRITE(*, cform_err) 
     198         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
     199         CALL mpi_abort( mpi_comm_world, code, ierr ) 
     200      ENDIF 
     201 
     202      IF( mpi_was_called ) THEN 
     203         ! 
    256204         SELECT CASE ( cn_mpi_send ) 
    257205         CASE ( 'S' )                ! Standard mpi send (blocking) 
    … …  
    259207         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    260208            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     209            CALL mpi_init_opa( ierr )  
    261210         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    262211            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    … …  
    267216            nstop = nstop + 1 
    268217         END SELECT 
     218      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
     219         WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
     220         WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
     221         nstop = nstop + 1 
     222      ELSE 
     223         SELECT CASE ( cn_mpi_send ) 
     224         CASE ( 'S' )                ! Standard mpi send (blocking) 
     225            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
     226            CALL mpi_init( ierr ) 
     227         CASE ( 'B' )                ! Buffer mpi send (blocking) 
     228            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     229            CALL mpi_init_opa( ierr ) 
     230         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     231            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     232            l_isend = .TRUE. 
     233            CALL mpi_init( ierr ) 
     234         CASE DEFAULT 
     235            WRITE(ldtxt(7),cform_err) 
     236            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
     237            nstop = nstop + 1 
     238         END SELECT 
     239         ! 
    269240      ENDIF 
    270241 
    271       mpi_comm_opa = mpi_comm_world 
    272 #endif 
     242      IF( PRESENT(localComm) ) THEN  
     243         IF( Agrif_Root() ) THEN 
     244            mpi_comm_opa = localComm 
     245         ENDIF 
     246      ELSE 
     247         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
     248         IF( code /= MPI_SUCCESS ) THEN 
     249            WRITE(*, cform_err) 
     250            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
     251            CALL mpi_abort( mpi_comm_world, code, ierr ) 
     252         ENDIF 
     253      ENDIF  
     254 
    273255      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    274256      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
    … …  
    20672049      ijpj   = 4 
    20682050      ijpjm1 = 3 
     2051      ztab(:,:,:) = 0.e0 
    20692052      ! 
    20702053      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d 
    … …  
    21322115      ijpj   = 4 
    21332116      ijpjm1 = 3 
     2117      ztab(:,:) = 0.e0 
    21342118      ! 
    21352119      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d 
    … …  
    21972181      ! 
    21982182      ijpj=4 
     2183      ztab(:,:) = 0.e0 
    21992184 
    22002185      ij=0 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/opa.F90

    r1725 r2007  
    156156      CALL opa_closefile 
    157157#if defined key_oasis3 || defined key_oasis4 
    158       CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
     158      IF( Agrif_Root() ) THEN 
     159         CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
     160     ENDIF  
    159161#else 
    160162      IF( lk_mpp )   CALL mppstop       ! end mpp communications 
    … …  
    191193#if defined key_iomput 
    192194# if defined key_oasis3 || defined key_oasis4 
    193       CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    194       CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it) 
     195      IF( Agrif_Root() ) THEN 
     196         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     197         CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it) 
     198      ENDIF 
    195199# else 
    196       CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server 
     200      IF( Agrif_Root() ) THEN 
     201         CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server 
     202      ENDIF 
    197203# endif 
    198204      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection 
    … …  
    200206#else 
    201207# if defined key_oasis3 || defined key_oasis4 
    202       CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     208      IF( Agrif_Root() ) THEN 
     209         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     210      ENDIF 
    203211      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt) 
    204212# else 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/par_POMME_R025.h90

    r1648 r2007  
    2222      jp_cfg = 025  ,        &  !: resolution of the configuration (degrees) 
    2323      ! Original data size 
    24  
    2524      ! ORCA025 global grid size 
    2625      jpiglo_ORCA025 = 1442, & 
    2726      jpjglo_ORCA025 = 1021, &  ! not used currently 
    28  
    2927      ! POMME "global" domain localisation in the ORCA025 global grid 
    3028      jpi_iw    = 1059,      &  
    … …  
    3230      jpj_js    = 661,       & 
    3331      jpj_jn    = 700,       & 
    34  
    3532      jpidta  = ( jpi_ie - jpi_iw + 1 ), &   !: =30 first horizontal dimension > or = to jpi 
    3633      jpjdta  = ( jpj_jn - jpj_js + 1 ), &   !: =40 second                     > or = to jpj 
    3734      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk 
    38  
    3935      ! total domain matrix size 
    4036      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/step.F90

    r1756 r2007  
    166166#if defined key_agrif 
    167167      kstp = nit000 + Agrif_Nb_Step() 
    168 !      IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
    169 !      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
     168!      IF( Agrif_Root() .and. lwp) Write(*,*) '---' 
     169!      IF(lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
     170# if defined key_iomput 
     171      IF( Agrif_Nbstepint() == 0) CALL iom_swap 
     172# endif    
    170173#endif    
    171174      indic = 1                                       ! reset to no error condition 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r1581 r2007  
    126126      zrgb(1,51) =  3.162   ;   zrgb(2,51) = 0.22703   ;   zrgb(3,51) = 0.16599   ;   zrgb(4,51) = 0.46601 
    127127      zrgb(1,52) =  3.548   ;   zrgb(2,52) = 0.24433   ;   zrgb(3,52) = 0.17334   ;   zrgb(4,52) = 0.47313 
    128       zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,54) = 0.48080 
    129       zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,55) = 0.48909 
    130       zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,56) = 0.49803 
    131       zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,57) = 0.50768 
    132       zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,58) = 0.51810 
    133       zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,59) = 0.52934 
    134       zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,50) = 0.54147 
     128      zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,53) = 0.48080 
     129      zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,54) = 0.48909 
     130      zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,55) = 0.49803 
     131      zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,56) = 0.50768 
     132      zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,57) = 0.51810 
     133      zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,58) = 0.52934 
     134      zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,59) = 0.54147 
    135135      zrgb(1,60) =  8.912   ;   zrgb(2,60) = 0.44336   ;   zrgb(3,60) = 0.25725   ;   zrgb(4,60) = 0.55457 
    136136      zrgb(1,61) = 10.000   ;   zrgb(2,61) = 0.47804   ;   zrgb(3,61) = 0.27178   ;   zrgb(4,61) = 0.56870 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/C14b/trclsm_c14b.F90

    r1581 r2007  
    4444      INTEGER ::   numnatb 
    4545 
    46 #if defined key_trc_diaadd 
     46#if defined key_trc_diaadd && ! defined key_iomput 
    4747      ! definition of additional diagnostic as a structure 
    4848      INTEGER ::   jl, jn 
    … …  
    5858      !! 
    5959      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b 
    60 #if defined key_trc_diaadd 
     60#if defined key_trc_diaadd && ! defined key_iomput 
    6161      NAMELIST/namc14dia/nwritedia, c14dia2d, c14dia3d     ! additional diagnostics 
    6262#endif 
    … …  
    8181      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b 
    8282      ! 
    83 #if defined key_trc_diaadd 
     83#if defined key_trc_diaadd && ! defined key_iomput 
    8484 
    8585      ! Namelist namc14dia 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/CFC/trcctl_cfc.F90

    r1255 r2007  
    4444      IF( jp_cfc > 2) THEN  
    4545          IF(lwp) THEN  
    46               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    47               WRITE (numout,*) ' =======   ============= ' 
     46              WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 
    4847              WRITE (numout,*)                             & 
    4948              &   ' STOP, change jp_cfc to 1 or 2 in par_CFC module '   
    … …  
    6261 
    6362      IF(lwp) THEN 
    64          WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    65          WRITE (numout,*) ' =======   ============= ' 
     63         WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 
    6664         WRITE (numout,*) ' we force tracer names' 
    6765         DO jl = 1, jp_cfc 
    … …  
    8078            ctrcun(jn) = 'mole/m3' 
    8179            IF(lwp) THEN 
    82                WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    83                WRITE (numout,*) ' =======   ============= ' 
     80               WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 
    8481               WRITE (numout,*) ' we force tracer unit' 
    8582               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/CFC/trclsm_cfc.F90

    r1581 r2007  
    4343      !!---------------------------------------------------------------------- 
    4444      INTEGER ::   numnatc 
    45 #if defined key_trc_diaadd 
     45#if defined key_trc_diaadd && ! defined key_iomput 
    4646      ! definition of additional diagnostic as a structure 
    4747      INTEGER :: jl, jn 
    … …  
    5656      !! 
    5757      NAMELIST/namcfcdate/ ndate_beg, nyear_res 
    58 #if defined key_trc_diaadd 
     58#if defined key_trc_diaadd && ! defined key_iomput 
    5959      NAMELIST/namcfcdia/nwritedia, cfcdia2d     ! additional diagnostics 
    6060#endif 
    … …  
    7979      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg 
    8080      ! 
    81 #if defined key_trc_diaadd 
     81#if defined key_trc_diaadd && ! defined key_iomput 
    8282 
    8383      ! Namelist namcfcdia 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r1457 r2007  
    482482      ENDIF 
    483483 
     484      IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
     485 
    484486      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    485487         WRITE(charout, FMT="('bio')") 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r1457 r2007  
    164164      ENDIF 
    165165 
     166      IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
     167 
    166168      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    167169         WRITE(charout, FMT="('exp')") 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r1542 r2007  
    2626   PUBLIC   trc_ini_lobster   ! called by trcini.F90 module 
    2727 
    28 #  include "domzgr_substitute.h90" 
    2928#  include "top_substitute.h90" 
    3029   !!---------------------------------------------------------------------- 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r1445 r2007  
    2828 
    2929   !!* Substitution 
    30 #  include "domzgr_substitute.h90" 
     30#  include "top_substitute.h90" 
    3131   !!---------------------------------------------------------------------- 
    3232   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r1457 r2007  
    2929 
    3030   !!* Substitution 
    31 #  include "domzgr_substitute.h90" 
     31#  include "top_substitute.h90" 
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    136136      ENDIF 
    137137 
     138      IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
     139 
    138140      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    139141         WRITE(charout, FMT="('sed')") 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r1678 r2007  
    3939 
    4040   !!* Substitution 
    41 #  include "domzgr_substitute.h90" 
     41#  include "top_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

    r1180 r2007  
    147147 
    148148   !!* Substitution 
    149 #include "domzgr_substitute.h90" 
     149#include "top_substitute.h90" 
    150150   !!---------------------------------------------------------------------- 
    151151   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r1737 r2007  
    5252 
    5353   !!* Substitution 
    54 #  include "domzgr_substitute.h90" 
     54#  include "top_substitute.h90" 
    5555   !!---------------------------------------------------------------------- 
    5656   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    204204          CALL mpp_sum( t_oce_co2_flx )   ! sum over the global domain 
    205205        ENDIF 
     206        ! Conversion in GtC/yr ; negative for outgoing from ocean 
     207        t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15 
     208        ! 
    206209        WRITE(numout,*) ' Atmospheric pCO2    :' 
    207210        WRITE(numout,*) '-------------------- : ',kt,'  ',t_atm_co2_flx 
    208211        WRITE(numout,*) '(ppm)' 
    209         WRITE(numout,*) 'Total Flux of Carbon :' 
    210         WRITE(numout,*) '-------------------- : ',t_oce_co2_flx * 12. / 1e15 
    211         WRITE(numout,*) '(GtC/an)' 
     212        WRITE(numout,*) 'Total Flux of Carbon out of the ocean :' 
     213        WRITE(numout,*) '-------------------- : ',t_oce_co2_flx 
     214        WRITE(numout,*) '(GtC/yr)' 
    212215        t_atm_co2_flx = 0. 
    213216        t_oce_co2_flx = 0. 
     217# if defined key_iomput 
     218        CALL iom_put( "tatpco2" , t_atm_co2_flx  ) 
     219        CALL iom_put( "tco2flx" , t_oce_co2_flx  ) 
     220#endif 
    214221      ENDIF 
    215222#endif 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r1152 r2007  
    4141 
    4242   !!* Substitution 
    43 #  include "domzgr_substitute.h90" 
     43#  include "top_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r1735 r2007  
    6767#if defined key_trc_dia3d && defined key_iomput 
    6868      REAL(wp) ::   zrfact2 
    69       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss, zw3d 
     69      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss 
    7070#endif 
    7171      CHARACTER (len=25) :: charout 
    … …  
    9494                  ! SET DUMMY VARIABLE FOR TOTAL BORATE 
    9595                  zbot  = borat(ji,jj,jk) 
     96 
     97                  ! SET DUMMY VARIABLE FOR TOTAL BORATE 
     98                  zbot  = borat(ji,jj,jk) 
    9699                  zfact = rhop (ji,jj,jk) / 1000. + rtrn 
    97100 
    … …  
    171174#  else 
    172175      zrfact2 = 1.e3 * rfact2r 
    173       zw3d(:,:,:) = hi  (:,:,:)                    * tmask(:,:,:) 
    174       CALL iom_put( "PH", zw3d ) 
    175       zw3d(:,:,:) = zco3(:,:,:)                    * tmask(:,:,:) 
    176       CALL iom_put( "CO3", zw3d ) 
    177       zw3d(:,:,:) = aksp(:,:,:) / calcon           * tmask(:,:,:) 
    178       CALL iom_put( "CO3sat", zw3d ) 
    179       zw3d(:,:,:) = zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) 
    180       CALL iom_put( "Dcal", zw3d ) 
     176      CALL iom_put( "PH"    , hi      (:,:,:)           * tmask(:,:,:) ) 
     177      CALL iom_put( "CO3"   , zco3    (:,:,:)           * tmask(:,:,:) ) 
     178      CALL iom_put( "CO3sat", aksp    (:,:,:) / calcon  * tmask(:,:,:) ) 
     179      CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 
    181180#  endif 
    182181# endif 
    … …  
    232231   END SUBROUTINE p4z_lys 
    233232#endif  
    234  
    235233   !!====================================================================== 
    236234END MODULE  p4zlys 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    r1736 r2007  
    4545 
    4646   !!* Substitution 
    47 #  include "domzgr_substitute.h90" 
     47#  include "top_substitute.h90" 
    4848   !!---------------------------------------------------------------------- 
    4949   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    7676#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
    7777      REAL(wp) :: zrfact2 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
    7978#endif 
    8079 
    … …  
    203202      END DO 
    204203       
     204#if defined key_trc_dia3d 
     205      ! Total grazing ( grazing by microzoo is already computed in p4zmicro )  
     206      grazing(:,:,:) = grazing(:,:,:) + (  zgrazd  (:,:,:) + zgrazz  (:,:,:) + zgrazn(:,:,:) & 
     207                     &                   + zgrazpoc(:,:,:) + zgrazffe(:,:,:)  ) 
     208#endif 
     209 
    205210 
    206211      DO jk = 1,jpkm1 
    … …  
    311316#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
    312317      zrfact2 = 1.e3 * rfact2r 
    313       zw3d(:,:,:) = (     zgrazd(:,:,:) +   zgrazz(:,:,:) + zgrazn(:,:,:) & 
    314                     & + zgrazpoc(:,:,:) + zgrazffe(:,:,:)                 ) * zrfact2 * tmask(:,:,:) 
    315       IF( jnt == nrdttrc ) CALL iom_put( "Graz2" , zw3d ) 
    316  
    317       zw3d(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 
    318       IF( jnt == nrdttrc ) CALL iom_put( "Pcal"  , zw3d ) 
     318      ! Total grazing of phyto by zoo 
     319      grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:) 
     320      ! Calcite production 
     321      prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 
     322      IF( jnt == nrdttrc ) then  
     323         CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton 
     324         CALL iom_put( "PCAL" , prodcal  )  ! Calcite production 
     325      ENDIF 
    319326#endif 
    320327 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    r1736 r2007  
    4343 
    4444   !!* Substitution 
    45 #  include "domzgr_substitute.h90" 
     45#  include "top_substitute.h90" 
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    7070      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazmf, zgrazsf, zgrazpf 
    7171      CHARACTER (len=25) :: charout 
    72 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
    73       REAL(wp) :: zrfact2 
    74       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
    75 #endif 
    7672 
    7773      !!--------------------------------------------------------------------- 
    … …  
    8884      zgrazpf(:,:,:) = 0. 
    8985 
     86#if defined key_trc_dia3d 
     87      grazing(:,:,:) = 0.  !: Initialisation of  grazing 
     88#endif 
    9089 
    9190      zstep = rfact2 / rday      ! Time step duration for biology 
    … …  
    156155      END DO 
    157156       
     157#if defined key_trc_dia3d 
     158      ! Grazing by microzooplankton 
     159      grazing(:,:,:) = grazing(:,:,:) + zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:)  
     160#endif 
    158161 
    159162      DO jk = 1,jpkm1 
    … …  
    231234      END DO 
    232235      ! 
    233 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
    234       zrfact2 = 1.e3 * rfact2r 
    235       zw3d(:,:,:) = ( zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:) ) * zrfact2 * tmask(:,:,:) 
    236       IF( jnt == nrdttrc ) CALL iom_put( "Graz" , zw3d ) 
    237 #endif 
    238  
    239        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     236      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    240237         WRITE(charout, FMT="('micro')") 
    241238         CALL prt_ctl_trc_info(charout) 
    242239         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    243        ENDIF 
     240      ENDIF 
    244241 
    245242   END SUBROUTINE p4z_micro 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90

    r1736 r2007  
    4141 
    4242   !!* Substitution 
    43 #  include "domzgr_substitute.h90" 
     43#  include "top_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r1678 r2007  
    3535    
    3636   !!* Substitution 
    37 #  include "domzgr_substitute.h90" 
     37#  include "top_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    6161      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekg, zekr, zekb 
    6262      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1 , ze2 , ze3, ze0 
    63 #if defined key_trc_diaadd && defined key_iomput 
    64      REAL(wp), DIMENSION(jpi,jpj)      ::   zw2d 
    65      REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   zw3d 
    66 #endif 
    6763      !!--------------------------------------------------------------------- 
    6864 
    … …  
    238234# else 
    239235      ! write diagnostics  
    240       zw2d(:,:  ) =  heup(:,:  ) * tmask(:,:,1) 
    241       zw3d(:,:,:) =  etot(:,:,:) * tmask(:,:,:) 
    242       IF( jnt == nrdttrc ) CALL iom_put( "Heup", zw2d )                
    243       IF( jnt == nrdttrc ) CALL iom_put( "PAR" , zw3d ) 
     236      IF( jnt == nrdttrc ) then  
     237         CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
     238         CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     239      ENDIF 
    244240# endif 
    245241#endif 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r1736 r2007  
    5353 
    5454   !!* Substitution 
    55 #  include "domzgr_substitute.h90" 
     55#  include "top_substitute.h90" 
    5656   !!---------------------------------------------------------------------- 
    5757   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    8181#if defined key_trc_diaadd && defined key_trc_dia3d 
    8282      REAL(wp) ::   zrfact2 
    83 #if  defined key_iomput 
    84       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
    85 #endif 
    8683#endif 
    8784      REAL(wp), DIMENSION(jpi,jpj)     ::   zmixnano   , zmixdiat, zstrn 
    … …  
    352349        WRITE(numout,*) 'Total PP :' 
    353350        WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 
    354         WRITE(numout,*) '(GtC/an)' 
     351        WRITE(numout,*) '(GtC/yr)' 
    355352        tpp = 0. 
    356353      ENDIF 
    357354 
    358 #if defined key_trc_diaadd && defined key_trc_dia3d 
     355#if defined key_trc_diaadd && defined key_trc_dia3d && ! defined key_iomput 
     356      !   Supplementary diagnostics 
    359357      zrfact2 = 1.e3 * rfact2r 
    360       !   Supplementary diagnostics 
    361 #  if ! defined key_iomput 
    362358      trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
    363359      trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
    … …  
    366362      trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
    367363      trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
    368 #if ! defined key_kriest 
     364#  if ! defined key_kriest 
    369365      trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
     366#  endif 
    370367#endif 
    371368 
    372 # else 
    373       zw3d(:,:,:) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
    374       IF( jnt == nrdttrc ) CALL iom_put( "PPPHY" , zw3d ) 
    375       zw3d(:,:,:) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
    376       IF( jnt == nrdttrc ) CALL iom_put( "PPPHY2", zw3d ) 
    377       zw3d(:,:,:) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 
    378       IF( jnt == nrdttrc ) CALL iom_put( "PPNEWN" , zw3d ) 
    379       zw3d(:,:,:) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 
    380       IF( jnt == nrdttrc ) CALL iom_put( "PPNEWD", zw3d ) 
    381       zw3d(:,:,:) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
    382       IF( jnt == nrdttrc ) CALL iom_put( "PBSi"  , zw3d ) 
    383       zw3d(:,:,:) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
    384       IF( jnt == nrdttrc ) CALL iom_put( "PFeD"  , zw3d ) 
    385       zw3d(:,:,:) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
    386       IF( jnt == nrdttrc ) CALL iom_put( "PFeN"  , zw3d ) 
    387 # endif 
     369#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
     370      zrfact2 = 1.e3 * rfact2r 
     371      IF ( jnt == nrdttrc ) then 
     372         CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by nanophyto 
     373         CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by diatom 
     374         CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by nanophyto 
     375         CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by diatom 
     376         CALL iom_put( "PBSi"  , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 
     377         CALL iom_put( "PFeD"  , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by diatom 
     378         CALL iom_put( "PFeN"  , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by nanophyto 
     379      ENDIF 
    388380#endif 
    389381 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r1744 r2007  
    4545 
    4646   !!* Substitution 
    47 #  include "domzgr_substitute.h90" 
     47#  include "top_substitute.h90" 
    4848   !!---------------------------------------------------------------------- 
    4949   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90

    r1735 r2007  
    9696      REAL(wp) :: zrfact2 
    9797# if defined key_iomput 
    98      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d  
    9998     REAL(wp), DIMENSION(jpi,jpj)    ::    zw2d  
    10099# endif 
    … …  
    332331      trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 
    333332# else 
    334       ! write diagnostics 
    335       zw2d(:,:)   =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) & 
    336       &            * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)      
     333      ! surface downward net flux of iron 
     334      zw2d(:,:)   =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)  
    337335      IF( jnt == nrdttrc ) CALL iom_put( "Irondep", zw2d ) 
    338       zw3d(:,:,:) = znitrpot(:,:,:) * 1.e-7 * zrfact2  * fse3t(:,:,:) * tmask(:,:,:) 
    339       IF( jnt == nrdttrc ) CALL iom_put( "Nfix", zw3d  )  
    340 # endif 
    341  
     336      ! nitrogen fixation at surface 
     337      zw2d(:,:)   =  znitrpot(:,:,1) * 1.e-7 * zrfact2  * fse3t(:,:,1) * tmask(:,:,1) 
     338      IF( jnt == nrdttrc ) CALL iom_put( "Nfix" , zw2d ) 
     339# endif 
    342340# endif 
    343341      ! 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r1736 r2007  
    6969 
    7070   !!* Substitution 
    71 #  include "domzgr_substitute.h90" 
     71#  include "top_substitute.h90" 
    7272   !!---------------------------------------------------------------------- 
    7373   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    9999#if defined key_trc_diaadd 
    100100      REAL(wp) :: zrfact2 
    101       INTEGER  :: iksed1 
    102 #if defined key_iomput 
    103       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
    104 #endif 
     101      INTEGER  :: ik1 
    105102#endif 
    106103      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znum3d 
    … …  
    286283#if defined key_trc_diaadd 
    287284      zrfact2 = 1.e3 * rfact2r 
    288       iksed1 = iksed + 1 
     285      ik1 = iksed + 1 
    289286#  if ! defined key_iomput 
    290       trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    291       trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    292       trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    293       trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    294       trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     287      trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     288      trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
     289      trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     290      trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     291      trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    295292      trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zrfact2 * tmask(:,:,:) 
    296293      trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:) 
    … …  
    301298      trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)                * tmask(:,:,:) 
    302299#else 
    303       zw3d(:,:,:)  = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 
    304       IF( jnt == nrdttrc ) CALL iom_put( "PMO" , zw3d ) 
    305       zw3d(:,:,:)  = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 
    306       IF( jnt == nrdttrc ) CALL iom_put( "PMO2", zw3d ) 
    307       zw3d(:,:,:)  = sinkfer (:,:,:) * zrfact2 * tmask(:,:,:) 
    308       IF( jnt == nrdttrc ) CALL iom_put( "ExpFe1", zw3d ) 
    309       zw3d(:,:,:)  = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 
    310       IF( jnt == nrdttrc ) CALL iom_put( "ExpSi", zw3d ) 
    311       zw3d(:,:,:)  = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 
    312       IF( jnt == nrdttrc ) CALL iom_put( "ExpCaCO3", zw3d ) 
    313       zw3d(:,:,:)  = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 
    314       IF( jnt == nrdttrc ) CALL iom_put( "POCFlx", zw3d ) 
    315       zw3d(:,:,:)  = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 
    316       IF( jnt == nrdttrc ) CALL iom_put( "GOCFlx", zw3d ) 
    317       zw3d(:,:,:)  = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 
    318       IF( jnt == nrdttrc ) CALL iom_put( "SiFlx", zw3d ) 
    319       zw3d(:,:,:)  = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 
    320       IF( jnt == nrdttrc ) CALL iom_put( "CaCO3Flx", zw3d ) 
    321       zw3d(:,:,:)  = znum3d  (:,:,:)           * tmask(:,:,:) 
    322       IF( jnt == nrdttrc ) CALL iom_put( "xnum", zw3d ) 
    323       zw3d(:,:,:)  = wsbio3  (:,:,:)           * tmask(:,:,:) 
    324       IF( jnt == nrdttrc ) CALL iom_put( "W1", zw3d ) 
    325       zw3d(:,:,:)  = wsbio4  (:,:,:)           * tmask(:,:,:) 
    326       IF( jnt == nrdttrc ) CALL iom_put( "W2", zw3d ) 
     300      IF( jnt == nrdttrc ) then 
     301        CALL iom_put( "POCFlx"  , sinking (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! POC export 
     302        CALL iom_put( "NumFlx"  , sinking2 (:,:,:)     * zrfact2 * tmask(:,:,:) )  ! Num export 
     303        CALL iom_put( "SiFlx"   , sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Silica export 
     304        CALL iom_put( "CaCO3Flx", sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Calcite export 
     305        CALL iom_put( "xnum"    , znum3d  (:,:,:)                * tmask(:,:,:) )  ! Number of particles in aggregats 
     306        CALL iom_put( "W1"      , wsbio3  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of POC 
     307        CALL iom_put( "W2"      , wsbio4  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of aggregats 
     308        CALL iom_put( "PMO"     , sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! POC export at 100m 
     309        CALL iom_put( "PMO2"    , sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! Num export at 100m 
     310        CALL iom_put( "ExpFe1"  , sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! Export of iron at 100m 
     311        CALL iom_put( "ExpSi"   , sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! export of silica at 100m 
     312        CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! export of calcite at 100m 
     313     ENDIF 
    327314#  endif 
    328315 
    … …  
    489476#if defined key_trc_dia3d 
    490477      REAL(wp) ::   zrfact2 
    491       INTEGER  ::   iksed1 
    492 #endif 
    493 #if defined key_iomput 
    494       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
     478      INTEGER  ::   ik1 
    495479#endif 
    496480      CHARACTER (len=25) :: charout 
    … …  
    613597#if defined key_trc_diaadd 
    614598      zrfact2 = 1.e3 * rfact2r 
    615       iksed1 = iksed + 1 
     599      ik1 = iksed + 1 
    616600#  if ! defined key_iomput 
    617       trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    618       trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    619       trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    620       trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    621       trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    622       trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     601      trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     602      trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
     603      trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     604      trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
     605      trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     606      trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    623607#  else 
    624       zw3d(:,:,:)  = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 
    625       IF( jnt == nrdttrc ) CALL iom_put( "ExpPOC" , zw3d ) 
    626       zw3d(:,:,:)  = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 
    627       IF( jnt == nrdttrc ) CALL iom_put( "ExpGOC", zw3d ) 
    628       zw3d(:,:,:)  = sinkfer (:,:,:) * zrfact2 * tmask(:,:,:) 
    629       IF( jnt == nrdttrc ) CALL iom_put( "ExpFe1", zw3d ) 
    630       zw3d(:,:,:)  = sinkfer2(:,:,:) * zrfact2 * tmask(:,:,:) 
    631       IF( jnt == nrdttrc ) CALL iom_put( "ExpFe2", zw3d ) 
    632       zw3d(:,:,:)  = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 
    633       IF( jnt == nrdttrc ) CALL iom_put( "ExpSi", zw3d ) 
    634       zw3d(:,:,:)  = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 
    635       IF( jnt == nrdttrc ) CALL iom_put( "Expcal", zw3d ) 
    636 #  endif 
     608      IF( jnt == nrdttrc )  then 
     609         CALL iom_put( "EPC100"  , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 
     610         CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 
     611         CALL iom_put( "EPCAL100",   sinkcal(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of calcite  at 100m 
     612         CALL iom_put( "EPSI100" ,   sinksil(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 
     613      ENDIF 
     614#endif 
    637615#endif 
    638616      ! 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r1678 r2007  
    3838   LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value 
    3939                                   !: when initialize from a restart file  
     40   LOGICAL  ::   ln_pisclo         !: Restoring or not of nutrients to initial value 
     41                                   !: on close seas 
    4042 
    4143   !!*  Biological fluxes for light 
    … …  
    6264#if defined key_trc_dia3d 
    6365   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prodcal    !: Calcite production 
     66   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazing    !: Total zooplankton grazing 
    6467#endif 
    6568 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r1542 r2007  
    3838      no3    =  31.04e-6 * 7.6 
    3939 
    40 #  include "domzgr_substitute.h90" 
    4140#  include "top_substitute.h90" 
    4241   !!---------------------------------------------------------------------- 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90

    r1581 r2007  
    6767      NAMELIST/nampisdia/ nwritedia, pisdia3d, pisdia2d     ! additional diagnostics 
    6868#endif 
    69       NAMELIST/nampisdmp/ ln_pisdmp 
     69      NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo 
    7070 
    7171      !!---------------------------------------------------------------------- 
    … …  
    188188         WRITE(numout,*) 
    189189         WRITE(numout,*) ' Namelist : nampisdmp' 
    190          WRITE(numout,*) '    Relaxation of tracer to glodap mean value    ln_pisdmp      =', ln_pisdmp 
     190         WRITE(numout,*) '    Relaxation of tracer to glodap mean value            ln_pisdmp      =', ln_pisdmp 
     191         WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo 
    191192         WRITE(numout,*) ' ' 
    192193      ENDIF 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r1445 r2007  
    5353 
    5454   !! * Substitutions 
    55 #  include "domzgr_substitute.h90" 
     55#  include "top_substitute.h90" 
    5656   !!---------------------------------------------------------------------- 
    5757   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_imp.F90

    r1271 r2007  
    112112         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)       
    113113      ENDIF 
    114      !                                                       ! =========== 
     114 
     115      ! Initialisation 
     116      zwd( 1 ,:,:) = 0.e0     ;     zwd(jpi,:,:) = 0.e0 
     117      zws( 1 ,:,:) = 0.e0     ;     zws(jpi,:,:) = 0.e0 
     118      zwi( 1 ,:,:) = 0.e0     ;     zwi(jpi,:,:) = 0.e0 
     119      !                                           
     120      ! 0. Matrix construction  
     121      ! ---------------------- 
     122 
     123      ! Diagonal, inferior, superior 
     124      ! (including the bottom boundary condition via avs masked 
     125      DO jk = 1, jpkm1                     
     126         DO jj = 2, jpjm1                                     
     127            DO ji = fs_2, fs_jpim1   ! vector opt. 
     128               zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk  ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) ) 
     129               zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 
     130               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     131            END DO 
     132         END DO 
     133      END DO 
     134 
     135      ! Surface boudary conditions 
     136      DO jj = 2, jpjm1         
     137         DO ji = fs_2, fs_jpim1 
     138            zwi(ji,jj,1) = 0.e0 
     139            zwd(ji,jj,1) = 1. - zws(ji,jj,1)  
     140         END DO 
     141      END DO 
     142 
     143      !                                                       ! =========== 
    115144      DO jn = 1, jptra                                        ! tracer loop 
    116145         !                                                    ! =========== 
    117146         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)         ! ??? validation needed 
    118147 
    119     ! Initialisation      
    120     zwd( 1 ,:,:) = 0.e0     ;     zwd(jpi,:,:) = 0.e0 
    121     zws( 1 ,:,:) = 0.e0     ;     zws(jpi,:,:) = 0.e0 
    122     zwi( 1 ,:,:) = 0.e0     ;     zwi(jpi,:,:) = 0.e0 
    123148    zwt( 1 ,:,:) = 0.e0     ;     zwt(jpi,:,:) = 0.e0      
    124149         zwt(  :,:,1) = 0.e0     ;     zwt(  :,:,jpk) = 0.e0 
    125          !                                           
    126          ! 0. Matrix construction 
    127          ! ---------------------- 
    128  
    129          ! Diagonal, inferior, superior 
    130          ! (including the bottom boundary condition via avs masked 
    131          DO jk = 1, jpkm1                                                      
    132             DO jj = 2, jpjm1                                       
    133                DO ji = fs_2, fs_jpim1   ! vector opt. 
    134                   zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk  ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) ) 
    135                   zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 
    136                   zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    137                END DO 
    138             END DO 
    139          END DO 
    140  
    141          ! Surface boudary conditions 
    142          DO jj = 2, jpjm1         
    143             DO ji = fs_2, fs_jpim1 
    144                zwi(ji,jj,1) = 0.e0 
    145                zwd(ji,jj,1) = 1. - zws(ji,jj,1) 
    146             END DO 
    147          END DO 
    148150          
    149151         ! Second member construction 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_iso.F90

    r1271 r2007  
    182182 
    183183 
    184  
    185       DO jn = 1, jptra 
     184      ! 0.2 Update and save of avt (and avs if double diffusive mixing) 
     185      ! --------------------------- 
     186 
     187     DO jj = 2, jpjm1                                 !  Vertical slab 
     188        !                                             ! =============== 
     189         DO jk = 2, jpkm1 
     190            DO ji = 2, jpim1 
     191               zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk)   & 
     192                  &                     +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) ) 
     193               ! add isopycnal vertical coeff. to avs 
     194               fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi 
     195            END DO 
     196         END DO 
     197       ! 
     198     END DO 
     199 
     200 
     201 
     202     DO jn = 1, jptra 
    186203 
    187204         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends 
    … …  
    262279            END DO 
    263280 
    264  
    265             ! I.3  update and save of avt (and avs if double diffusive mixing) 
    266             ! --------------------------- 
    267  
    268             DO jk = 2, jpkm1 
    269                DO ji = 2, jpim1 
    270  
    271                   zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk)   & 
    272                      &                     +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) ) 
    273  
    274                   ! add isopycnal vertical coeff. to avs 
    275                   fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi 
    276  
    277                END DO 
    278             END DO 
    279281 
    280282#if defined key_trcldf_eiv 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90

    r1328 r2007  
    154154                            zws   => va      ! workspace 
    155155      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    156       INTEGER ::   ji, jj, jk, jn            ! dummy loop indices 
     156      INTEGER  ::   ji, jj, jk, jn            ! dummy loop indices 
    157157      REAL(wp) ::   zavi, zrhs               ! temporary scalars 
    158158      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    … …  
    180180      ENDIF 
    181181 
     182          
     183      zwd  ( 1, :, : ) = 0.e0    ;     zwd  ( jpi, :,   : ) = 0.e0 
     184      zws  ( 1, :, : ) = 0.e0    ;     zws  ( jpi, :,   : ) = 0.e0 
     185      zwi  ( 1, :, : ) = 0.e0    ;     zwi  ( jpi, :,   : ) = 0.e0 
     186      zwt  ( 1, :, : ) = 0.e0    ;     zwt  ( jpi, :,   : ) = 0.e0 
     187      zwt  ( :, :, 1 ) = 0.e0    ;     zwt  (   :, :, jpk ) = 0.e0 
     188      zavsi( 1, :, : ) = 0.e0    ;     zavsi( jpi, :,   : ) = 0.e0  
     189      zavsi( :, :, 1 ) = 0.e0    ;     zavsi(   :, :, jpk ) = 0.e0 
     190 
     191 
     192      ! II. Vertical trend associated with the vertical physics 
     193      !======================================================= 
     194      !     (including the vertical flux proportional to dk[t] associated 
     195      !      with the lateral mixing, through the avt update) 
     196      !     dk[ avt dk[ (t,s) ] ] diffusive trends 
     197 
     198      ! II.0 Matrix construction 
     199      ! ------------------------         
     200      ! update and save of avt (and avs if double diffusive mixing) 
     201      DO jk = 2, jpkm1 
     202         DO jj = 2, jpjm1 
     203            DO ji = fs_2, fs_jpim1   ! vector opt. 
     204               zavi = fsahtw(ji,jj,jk) * (                 &   ! vertical mixing coef. due to lateral mixing 
     205                  &                           wslpi(ji,jj,jk) * wslpi(ji,jj,jk)      & 
     206                  &                         + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) 
     207               zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi        ! dd mixing: zavsi = total vertical mixing coef. on tracer 
     208            END DO 
     209         END DO 
     210      END DO 
     211 
     212      ! II.1 Vertical diffusion on tracer 
     213      ! --------------------------------- 
     214      ! Rebuild the Matrix as avt /= avs 
     215 
     216      ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked) 
     217      DO jk = 1, jpkm1 
     218         DO jj = 2, jpjm1 
     219            DO ji = fs_2, fs_jpim1   ! vector opt. 
     220               zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk  ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) ) 
     221               zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 
     222               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     223            END DO 
     224         END DO 
     225      END DO 
     226 
     227      ! Surface boudary conditions 
     228      DO jj = 2, jpjm1 
     229         DO ji = fs_2, fs_jpim1   ! vector opt. 
     230            zwi(ji,jj,1) = 0.e0 
     231            zwd(ji,jj,1) = 1. - zws(ji,jj,1) 
     232         END DO 
     233      END DO 
     234 
     235      !! Matrix inversion from the first level 
     236      !!---------------------------------------------------------------------- 
     237      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk ) 
     238      ! 
     239      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 ) 
     240      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 ) 
     241      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 ) 
     242      !        (        ...               )( ...  ) ( ...  ) 
     243      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk ) 
     244      ! 
     245      !   m is decomposed in the product of an upper and lower triangular 
     246      !   matrix 
     247      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 
     248      !   The second member is in 2d array zwy 
     249      !   The solution is in 2d array zwx 
     250      !   The 3d arry zwt is a work space array 
     251      !   zwy is used and then used as a work space array : its value is modified! 
     252 
     253      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
     254      DO jj = 2, jpjm1 
     255         DO ji = fs_2, fs_jpim1 
     256            zwt(ji,jj,1) = zwd(ji,jj,1) 
     257         END DO 
     258      END DO 
     259      DO jk = 2, jpkm1 
     260         DO jj = 2, jpjm1 
     261            DO ji = fs_2, fs_jpim1 
     262               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)/zwt(ji,jj,jk-1) 
     263            END DO 
     264         END DO 
     265      END DO 
     266 
    182267      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
    183268 
    … …  
    187272          
    188273         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends 
    189           
    190          zwd  ( 1, :, : ) = 0.e0    ;     zwd  ( jpi, :,   : ) = 0.e0 
    191          zws  ( 1, :, : ) = 0.e0    ;     zws  ( jpi, :,   : ) = 0.e0 
    192          zwi  ( 1, :, : ) = 0.e0    ;     zwi  ( jpi, :,   : ) = 0.e0 
    193          zwt  ( 1, :, : ) = 0.e0    ;     zwt  ( jpi, :,   : ) = 0.e0 
    194          zwt  ( :, :, 1 ) = 0.e0    ;     zwt  (   :, :, jpk ) = 0.e0 
    195          zavsi( 1, :, : ) = 0.e0    ;     zavsi( jpi, :,   : ) = 0.e0  
    196          zavsi( :, :, 1 ) = 0.e0    ;     zavsi(   :, :, jpk ) = 0.e0 
    197274 
    198275#  if defined key_trc_diatrd 
    … …  
    200277         ztrd(:,:,:) = tra(:,:,:,jn) 
    201278#  endif 
    202  
    203          ! II. Vertical trend associated with the vertical physics 
    204          ! ======================================================= 
    205          !     (including the vertical flux proportional to dk[t] associated 
    206          !      with the lateral mixing, through the avt update) 
    207          !     dk[ avt dk[ (t,s) ] ] diffusive trends 
    208  
    209  
    210          ! II.0 Matrix construction 
    211          ! ------------------------         
    212          ! update and save of avt (and avs if double diffusive mixing) 
    213          DO jk = 2, jpkm1 
    214             DO jj = 2, jpjm1 
    215                DO ji = fs_2, fs_jpim1   ! vector opt. 
    216                   zavi = fsahtw(ji,jj,jk) * (                 &   ! vertical mixing coef. due to lateral mixing 
    217                      &                           wslpi(ji,jj,jk) * wslpi(ji,jj,jk)      & 
    218                      &                         + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) 
    219                   zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi        ! dd mixing: zavsi = total vertical mixing coef. on tracer 
    220  
    221                END DO 
    222             END DO 
    223          END DO 
    224  
    225  
    226          ! II.1 Vertical diffusion on tracer 
    227          ! --------------------------------- 
    228  
    229          ! Rebuild the Matrix as avt /= avs 
    230  
    231          ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked) 
    232          DO jk = 1, jpkm1 
    233             DO jj = 2, jpjm1 
    234                DO ji = fs_2, fs_jpim1   ! vector opt. 
    235                   zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk  ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) ) 
    236                   zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 
    237                   zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    238                END DO 
    239             END DO 
    240          END DO 
    241  
    242          ! Surface boudary conditions 
    243          DO jj = 2, jpjm1 
    244             DO ji = fs_2, fs_jpim1   ! vector opt. 
    245                zwi(ji,jj,1) = 0.e0 
    246                zwd(ji,jj,1) = 1. - zws(ji,jj,1) 
    247             END DO 
    248          END DO 
    249  
    250          !! Matrix inversion from the first level 
    251          !!---------------------------------------------------------------------- 
    252          !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk ) 
    253          ! 
    254          !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 ) 
    255          !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 ) 
    256          !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 ) 
    257          !        (        ...               )( ...  ) ( ...  ) 
    258          !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk ) 
    259          ! 
    260          !   m is decomposed in the product of an upper and lower triangular 
    261          !   matrix 
    262          !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 
    263          !   The second member is in 2d array zwy 
    264          !   The solution is in 2d array zwx 
    265          !   The 3d arry zwt is a work space array 
    266          !   zwy is used and then used as a work space array : its value is modified! 
    267  
    268          ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
    269          DO jj = 2, jpjm1 
    270             DO ji = fs_2, fs_jpim1 
    271                zwt(ji,jj,1) = zwd(ji,jj,1) 
    272             END DO 
    273          END DO 
    274          DO jk = 2, jpkm1 
    275             DO jj = 2, jpjm1 
    276                DO ji = fs_2, fs_jpim1 
    277                   zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)  /zwt(ji,jj,jk-1) 
    278                END DO 
    279             END DO 
    280          END DO 
    281279 
    282280         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r1254 r2007  
    1818   USE par_lobster   ! LOBSTER model 
    1919   USE par_pisces    ! PISCES  model 
     20   USE par_c14b      ! C14 bomb tracer 
    2021   USE par_cfc       ! CFC 11 and 12 tracers 
    21    USE par_c14b      ! C14 bomb tracer  
    2222   USE par_my_trc    ! user defined passive tracers 
    2323 
    … …  
    2727   ! Passive tracers : Total size 
    2828   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    29    INTEGER, PUBLIC, PARAMETER ::   jptra    =  jp_lobster    + jp_pisces     + jp_cfc     + jp_c14b     + jp_my_trc 
    30    INTEGER, PUBLIC, PARAMETER ::   jpdia2d  =  jp_lobster_2d + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  + jp_my_trc_2d 
    31    INTEGER, PUBLIC, PARAMETER ::   jpdia3d  =  jp_lobster_3d + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  + jp_my_trc_3d 
     29   INTEGER, PUBLIC, PARAMETER ::   jptra    =  jp_lobster    + jp_pisces     + jp_cfc     + jp_my_trc 
     30   INTEGER, PUBLIC, PARAMETER ::   jpdia2d  =  jp_lobster_2d + jp_pisces_2d  + jp_cfc_2d  + jp_my_trc_2d 
     31   INTEGER, PUBLIC, PARAMETER ::   jpdia3d  =  jp_lobster_3d + jp_pisces_3d  + jp_cfc_3d  + jp_my_trc_3d 
    3232   !                     ! total number of sms diagnostic arrays 
    33    INTEGER, PUBLIC, PARAMETER ::   jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     33   INTEGER, PUBLIC, PARAMETER ::   jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_my_trc_trd 
    3434    
    3535   !  1D configuration ("key_c1d") 
    … …  
    4040   LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .FALSE.  !: 1D pass. tracer configuration flag 
    4141# endif 
    42  
    4342   ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined) 
    44 #if defined key_trcldf_eiv 
    45 # if defined key_trcdmp 
    46    INTEGER, PARAMETER :: jpdiatrc = 11      !: trends: 3*(advection + diffusion + eiv ) + damping + sms 
    47 # else 
    48    INTEGER, PARAMETER :: jpdiatrc = 10      !: trends: 3*(advection + diffusion + eiv )           + sms 
    49 # endif 
    50 #else 
    51 # if defined key_trcdmp 
    52    INTEGER, PARAMETER :: jpdiatrc =  8      !: trends: 3*(advection + diffusion       ) + damping + sms 
    53 # else 
    54    INTEGER, PARAMETER :: jpdiatrc =  7      !: trends: 3*(advection + diffusion       ) + damping + sms 
    55 # endif 
     43# if defined key_trc_diatrd 
     44   ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined) 
     45   INTEGER, PARAMETER ::   jptrc_xad     =  1   !: x- horizontal advection 
     46   INTEGER, PARAMETER ::   jptrc_yad     =  2   !: y- horizontal advection 
     47   INTEGER, PARAMETER ::   jptrc_zad     =  3   !: z- vertical   advection 
     48   INTEGER, PARAMETER ::   jptrc_xdf     =  4   !: lateral       diffusion 
     49   INTEGER, PARAMETER ::   jptrc_ydf     =  5   !: lateral       diffusion 
     50   INTEGER, PARAMETER ::   jptrc_zdf     =  6   !: vertical diffusion (Kz) 
     51   INTEGER, PARAMETER ::   jptrc_sbc     =  7   !: surface boundary condition 
     52#if ! defined key_trcldf_eiv && ! defined key_trcdmp 
     53   INTEGER, PARAMETER ::   jpdiatrc      =  7  !: trends: 3*(advection + diffusion       ) + sbc 
     54#endif 
     55#if defined key_trcldf_eiv && defined key_trcdmp 
     56   INTEGER, PARAMETER ::   jptrc_xei     =  8   !: x- horiz. EIV advection 
     57   INTEGER, PARAMETER ::   jptrc_yei     =  9   !: y- horiz. EIV advection 
     58   INTEGER, PARAMETER ::   jptrc_zei     = 10   !: z- vert.  EIV advection 
     59   INTEGER, PARAMETER ::   jptrc_dmp     = 11   !: damping 
     60   INTEGER, PARAMETER ::   jpdiatrc      = 11   !: trends: 3*(advection + diffusion + eiv ) + sbc + damping 
     61#endif 
     62#if defined key_trcldf_eiv && ! defined key_trcdmp 
     63   INTEGER, PARAMETER ::   jptrc_xei     =  8   !: x- horiz. EIV advection 
     64   INTEGER, PARAMETER ::   jptrc_yei     =  9   !: y- horiz. EIV advection 
     65   INTEGER, PARAMETER ::   jptrc_zei     = 10   !: z- vert.  EIV advection 
     66   INTEGER, PARAMETER ::   jpdiatrc      = 10   !: trends: 3*(advection + diffusion + eiv ) + sbc  
     67#endif 
     68#if ! defined key_trcldf_eiv && defined key_trcdmp 
     69   INTEGER, PARAMETER ::   jptrc_dmp     =  8   !: damping 
     70   INTEGER, PARAMETER ::   jpdiatrc      =  8   !: trends: 3*(advection + diffusion       ) + sbc + damping 
     71#endif 
    5672#endif 
    5773 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r1715 r2007  
    2525   USE trc 
    2626   USE trp_trc 
     27   USE par_trc 
    2728   USE trdmld_trc_oce, ONLY : luttrd 
    2829   USE dianam    ! build name of file (routine) 
    … …  
    4142   INTEGER  ::   ndimt50   !: number of ocean points in index array 
    4243   INTEGER  ::   ndimt51   !: number of ocean points in index array 
    43    REAL(wp) ::   xjulian   !: ????   not DOCTOR ! 
     44   REAL(wp) ::   zjulian   !: ????   not DOCTOR ! 
    4445   INTEGER , DIMENSION (jpij*jpk) ::   ndext50   !: integer arrays for ocean 3D index 
    4546   INTEGER , DIMENSION (jpij)     ::   ndext51   !: integer arrays for ocean surface index 
    … …  
    157158 
    158159         ! Compute julian date from starting date of the run 
    159          CALL ymds2ju( nyear, nmonth, nday, rdt, xjulian ) 
    160          xjulian = xjulian - adatrj   !   set calendar origin to the beginning of the experiment 
     160         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
     161         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    161162         IF(lwp)WRITE(numout,*)' '   
    162163         IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         & 
    163164            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   & 
    164             &                 ,'Julian day : ', xjulian   
     165            &                 ,'Julian day : ', zjulian   
    165166   
    166167         IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  & 
    … …  
    171172         IF(lwp) THEN 
    172173            CALL dia_nam( clhstnam, nwritetrc,' ' ) 
    173             CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     174            CALL ctlopn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea ) 
    174175            WRITE(inum,*) clhstnam 
    175176            CLOSE(inum) 
    … …  
    184185         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     & 
    185186            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &  
    186             &          nittrc000-ndttrc, xjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
     187            &          nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
    187188 
    188189         ! Vertical grid for tracer : gdept 
    … …  
    258259      CHARACTER (len=80) ::   cltral 
    259260      CHARACTER (len=10) ::   csuff 
    260       INTEGER  ::   jn, jl 
     261      INTEGER  ::   jn, jl, ikn 
    261262      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
    262263      REAL(wp) ::   zsto, zout, zdt 
    … …  
    313314               CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,       & 
    314315                  &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,   & 
    315                   &          nittrc000-ndttrc, xjulian, zdt, nhorit6(jn),  & 
     316                  &          nittrc000-ndttrc, zjulian, zdt, nhorit6(jn),  & 
    316317                  &          nit6(jn) , domain_id=nidom ) 
    317318 
    … …  
    322323 
    323324          ! Declare all the output fields as NETCDF variables 
    324  
    325           ! trends for tracer concentrations 
    326325          DO jn = 1, jptra 
    327326            IF( luttrd(jn) ) THEN 
    328327                DO jl = 1, jpdiatrc 
    329                   IF( jl == 1 ) THEN 
     328                  IF( jl == jptrc_xad ) THEN 
    330329                      ! short and long title for x advection for tracer 
    331330                      WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 
    332                       WRITE (cltral,'("X advective trend for ",58a)')  & 
    333                          &      ctrcnl(jn)(1:58) 
    334                   END IF 
    335                   IF( jl == 2 ) THEN 
     331                      WRITE (cltral,'("X advective trend for ",58a)') ctrcnl(jn)(1:58) 
     332                  END IF 
     333                  IF( jl == jptrc_yad ) THEN 
    336334                      ! short and long title for y advection for tracer 
    337335                      WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 
    338                       WRITE (cltral,'("Y advective trend for ",58a)')  & 
    339                          &      ctrcnl(jn)(1:58) 
    340                   END IF 
    341                   IF( jl == 3 ) THEN 
     336                      WRITE (cltral,'("Y advective trend for ",58a)') ctrcnl(jn)(1:58) 
     337                  END IF 
     338                  IF( jl == jptrc_zad ) THEN 
    342339                      ! short and long title for Z advection for tracer 
    343340                      WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 
    344                       WRITE (cltral,'("Z advective trend for ",58a)')  & 
    345                          &      ctrcnl(jn)(1:58) 
    346                   END IF 
    347                   IF( jl == 4 ) THEN 
     341                      WRITE (cltral,'("Z advective trend for ",58a)') ctrcnl(jn)(1:58) 
     342                  END IF 
     343                  IF( jl == jptrc_xdf ) THEN 
    348344                      ! short and long title for X diffusion for tracer 
    349345                      WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 
    350                       WRITE (cltral,'("X diffusion trend for ",58a)')  & 
    351                          &      ctrcnl(jn)(1:58) 
    352                   END IF 
    353                   IF( jl == 5 ) THEN 
     346                      WRITE (cltral,'("X diffusion trend for ",58a)') ctrcnl(jn)(1:58) 
     347                  END IF 
     348                  IF( jl == jptrc_ydf ) THEN 
    354349                      ! short and long title for Y diffusion for tracer 
    355350                      WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 
    356                       WRITE (cltral,'("Y diffusion trend for ",58a)')  & 
    357                          &      ctrcnl(jn)(1:58) 
    358                   END IF 
    359                   IF( jl == 6 ) THEN 
     351                      WRITE (cltral,'("Y diffusion trend for ",58a)') ctrcnl(jn)(1:58) 
     352                  END IF 
     353                  IF( jl == jptrc_zdf ) THEN 
    360354                      ! short and long title for Z diffusion for tracer 
    361355                      WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 
    362                       WRITE (cltral,'("Z diffusion trend for ",58a)')  & 
    363                          &      ctrcnl(jn)(1:58) 
     356                      WRITE (cltral,'("Z diffusion trend for ",58a)') ctrcnl(jn)(1:58) 
    364357                  END IF 
    365358# if defined key_trcldf_eiv 
    366                   IF( jl == 7 ) THEN 
     359                  IF( jl == jptrc_xei ) THEN 
    367360                      ! short and long title for x gent velocity for tracer 
    368361                      WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 
    369                       WRITE (cltral,'("X gent velocity trend for ",53a)')  & 
    370                          &      ctrcnl(jn)(1:53) 
    371                   END IF 
    372                   IF( jl == 8 ) THEN 
     362                      WRITE (cltral,'("X gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 
     363                  END IF 
     364                  IF( jl == jptrc_yei ) THEN 
    373365                      ! short and long title for y gent velocity for tracer 
    374366                      WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 
    375                       WRITE (cltral,'("Y gent velocity trend for ",53a)')  & 
    376                          &      ctrcnl(jn)(1:53) 
    377                   END IF 
    378                   IF( jl == 9 ) THEN 
     367                      WRITE (cltral,'("Y gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 
     368                  END IF 
     369                  IF( jl == jptrc_zei ) THEN 
    379370                      ! short and long title for Z gent velocity for tracer 
    380371                      WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 
    381                       WRITE (cltral,'("Z gent velocity trend for ",53a)')  & 
    382                          &      ctrcnl(jn)(1:53) 
     372                      WRITE (cltral,'("Z gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 
    383373                  END IF 
    384374# endif 
    385375# if defined key_trcdmp 
    386                   IF( jl == jpdiatrc - 1 ) THEN 
     376                  IF( jl == jptrc_dmp ) THEN 
    387377                      ! last trends for tracer damping : short and long title 
    388378                      WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 
    389                       WRITE (cltral,'("Tracer damping trend for ",55a)')  & 
    390                          &      ctrcnl(jn)(1:55) 
    391                   END IF 
    392 # endif 
    393                   IF( jl == jpdiatrc ) THEN 
     379                      WRITE (cltral,'("Tracer damping trend for ",55a)') ctrcnl(jn)(1:55) 
     380                  END IF 
     381# endif 
     382                  IF( jl == jptrc_sbc ) THEN 
    394383                      ! last trends for tracer damping : short and long title 
    395384                      WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 
    396                       WRITE (cltral,'("Surface boundary flux ",58a)')  & 
    397                       &      ctrcnl(jn)(1:58) 
    398                   END IF 
    399  
     385                      WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 
     386                  END IF 
     387                      WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 
     388                  END IF 
    400389                  CALL FLUSH( numout ) 
    401390                  cltrau = ctrcun(jn)      ! UNIT for tracer /trends 
    … …  
    406395            END IF 
    407396         END DO 
    408  
    409397         ! CLOSE netcdf Files 
    410398          DO jn = 1, jptra 
    … …  
    432420      DO jn = 1, jptra 
    433421         IF( luttrd(jn) ) THEN 
     422            ikn = ikeep(jn)  
    434423            DO jl = 1, jpdiatrc 
    435                ! short titles  
    436                IF( jl == 1)   WRITE (cltra,'("XAD_",16a)') ctrcnm(jn)      ! x advection for tracer 
    437                IF( jl == 2)   WRITE (cltra,'("YAD_",16a)') ctrcnm(jn)      ! z advection for tracer 
    438                IF( jl == 3)   WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn)      ! z advection for tracer 
    439                IF( jl == 4)   WRITE (cltra,'("XDF_",16a)') ctrcnm(jn)      ! x diffusion for tracer 
    440                IF( jl == 5)   WRITE (cltra,'("YDF_",16a)') ctrcnm(jn)      ! y diffusion for tracer 
    441                IF( jl == 6)   WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn)      ! z diffusion for tracer 
     424               ! short titles 
     425               IF( jl == jptrc_xad)   WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 
     426               IF( jl == jptrc_yad)   WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 
     427               IF( jl == jptrc_zad)   WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 
     428               IF( jl == jptrc_xdf)   WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 
     429               IF( jl == jptrc_ydf)   WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 
     430               IF( jl == jptrc_zdf)   WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 
    442431# if defined key_trcldf_eiv 
    443                IF( jl == 7)   WRITE (cltra,'("XGV_",16a)') ctrcnm(jn)      ! x gent velocity for tracer 
    444                IF( jl == 8)   WRITE (cltra,'("YGV_",16a)') ctrcnm(jn)      ! y gent velocity for tracer 
    445                IF( jl == 9)   WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn)      ! z gent velocity for tracer 
     432               IF( jl == jptrc_xei)   WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 
     433               IF( jl == jptrc_yei)   WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 
     434               IF( jl == jptrc_zei)   WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 
    446435# endif 
    447436# if defined key_trcdmp 
    448                IF( jl == jpdiatrc - 1 )   WRITE (cltra,'("TDM_",16a)') ctrcnm(jn)      ! damping 
    449 # endif 
    450                IF( jl == jpdiatrc )   WRITE (cltra,'("SBC_",a)') ctrcnm(jn)      ! surface boundary conditions 
     437               IF( jl == jptrc_dmp )  WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 
     438# endif 
     439               IF( jl == jptrc_sbc )  WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 
    451440               ! 
    452                CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikeep(jn),jl),ndimt50, ndext50) 
     441               CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikn,jl),ndimt50, ndext50) 
    453442            END DO 
    454443         END IF 
    … …  
    552541         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             & 
    553542            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    554             &          nittrc000-ndttrc, xjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
     543            &          nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
    555544 
    556545         ! Vertical grid for 2d and 3d arrays 
    … …  
    700689         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      & 
    701690            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          & 
    702             &    nittrc000-ndttrc, xjulian, zdt, nhoritb, nitb , domain_id=nidom ) 
     691            &    nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 
    703692         ! Vertical grid for biological trends 
    704693         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb) 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r1645 r2007  
    2525   PUBLIC trc_dta   ! called in trcini.F90 and trcdmp.F90 
    2626 
     27   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag 
    2728   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) ::   trdta   !: tracer data at given time-step 
    2829 
    … …  
    6263      !! 
    6364      CHARACTER (len=39) ::   clname(jptra) 
    64       INTEGER, PARAMETER ::   jpmois  = 12        ! number of months 
     65      INTEGER, PARAMETER ::   & 
     66         jpmonth = 12    ! number of months 
    6567      INTEGER ::   ji, jj, jn, jl  
    6668      INTEGER ::   imois, iman, i15, ik  ! temporary integers  
    … …  
    8183            ENDIF 
    8284            ! Initialization 
    83             iman = jpmois 
     85            iman = jpmonth 
    8486            i15  = nday / 16 
    8587            imois = nmonth + i15 -1 
    … …  
    188190            ! Read init file only 
    189191            IF( kt == nittrc000  ) THEN 
     192               ntrc1(jn) = 1 
    190193               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) 
    191194               trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) 
    … …  
    204207   !!   Dummy module                              NO 3D passive tracer data 
    205208   !!---------------------------------------------------------------------- 
     209   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .FALSE.   !: temperature data flag 
    206210CONTAINS 
    207211   SUBROUTINE trc_dta( kt )        ! Empty routine 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r1745 r2007  
    122122         trb(:,:,:,:) = trn(:,:,:,:) 
    123123      ELSE 
     124         ! 
    124125         CALL trc_rst_read      ! restart from a file 
    125 #if defined key_off_tra 
    126          CALL day_init          ! calendar 
    127 #endif 
     126         ! 
    128127      ENDIF 
    129128 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r1655 r2007  
    11MODULE trcrst 
    22   !!====================================================================== 
    3    !!                       ***  MODULE trcrst  *** 
    4    !! TOP :   create, write, read the restart files for passive tracers 
     3   !!                         ***  MODULE trcrst  *** 
     4   !! TOP :   Manage the passive tracer restart 
    55   !!====================================================================== 
    6    !! History :   1.0  !  2007-02 (C. Ethe) adaptation from the ocean 
     6   !! History :    -   !  1991-03  ()  original code 
     7   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
     8   !!              -   !  2005-10 (C. Ethe) print control 
     9   !!             2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture 
    710   !!---------------------------------------------------------------------- 
    811#if defined key_top 
     12   !!---------------------------------------------------------------------- 
     13   !!   'key_top'                                                TOP models 
     14   !!---------------------------------------------------------------------- 
     15   !!---------------------------------------------------------------------- 
     16   !!   trc_rst :   Restart for passive tracer 
     17   !!---------------------------------------------------------------------- 
    918   !!---------------------------------------------------------------------- 
    1019   !!   'key_top'                                                TOP models 
    … …  
    1625   USE oce_trc 
    1726   USE trc 
    18    USE sms_lobster         ! LOBSTER variables 
    19    USE sms_pisces          ! PISCES variables 
    20    USE trcsms_cfc          ! CFC variables 
    21    USE trcsms_c14b         ! C14 variables 
    22    USE trcsms_my_trc       ! MY_TRC variables 
    23    USE trctrp_lec    
     27   USE trctrp_lec 
    2428   USE lib_mpp 
    2529   USE iom 
    26     
     30   USE trcrst_cfc      ! CFC       
     31   USE trcrst_lobster  ! LOBSTER  restart 
     32   USE trcrst_pisces   ! PISCES   restart 
     33   USE trcrst_c14b     ! C14 bomb restart 
     34   USE trcrst_my_trc   ! MY_TRC   restart 
     35#if defined key_off_tra 
     36    USE daymod 
     37#endif 
    2738   IMPLICIT NONE 
    2839   PRIVATE 
    29     
     40 
    3041   PUBLIC   trc_rst_opn       ! called by ??? 
    3142   PUBLIC   trc_rst_read      ! called by ??? 
    3243   PUBLIC   trc_rst_wri       ! called by ??? 
    33     
     44 
    3445   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write) 
    35  
    3646 
    3747   !! * Substitutions 
    … …  
    8999   END SUBROUTINE trc_rst_opn 
    90100 
    91  
    92    SUBROUTINE trc_rst_read  
     101   SUBROUTINE trc_rst_read 
    93102      !!---------------------------------------------------------------------- 
    94103      !!                    ***  trc_rst_opn  *** 
    … …  
    96105      !! ** purpose  :   read passive tracer fields in restart files 
    97106      !!---------------------------------------------------------------------- 
    98       INTEGER  ::  jn   
    99       INTEGER  ::  iarak0 
     107      INTEGER  ::  jn      
     108      INTEGER  ::  iarak0  
    100109      REAL(wp) ::  zarak0 
    101110      INTEGER  ::  jlibalt = jprstlib 
    102111      LOGICAL  ::  llok 
    103 #if defined key_pisces  
    104       INTEGER  ::  ji, jj, jk 
    105       REAL(wp) ::  zcaralk, zbicarb, zco3 
    106       REAL(wp) ::  ztmas, ztmas1 
    107 #endif 
    108112 
    109113      !!---------------------------------------------------------------------- 
    … …  
    115119      IF ( jprstlib == jprstdimg ) THEN 
    116120        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    117         ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 
     121        ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90  
    118122        INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
    119         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    120       ENDIF 
    121        
    122       CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 
     123        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF  
     124      ENDIF 
     125 
     126      CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )  
    123127 
    124128      ! Time domain : restart 
    … …  
    136140         & ' centered or euler '  ) 
    137141      IF(lwp) WRITE(numout,*) 
    138  
    139142      IF(lwp) WRITE(numout,*) '    arakawa option      : ', NINT( zarak0 ) 
    140143 
    141  
    142144      ! READ prognostic variables and computes diagnostic variable 
    143145      DO jn = 1, jptra 
    144          CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )  
    145       END DO 
    146  
    147       DO jn = 1, jptra 
    148          CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )  
    149       END DO 
    150  
    151 #if defined key_lobster 
    152       CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )  
    153       CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )  
    154 #endif 
    155 #if defined key_pisces 
    156       ! 
    157       IF( ln_pisdmp ) CALL pis_dmp_ini  ! relaxation of some tracers 
    158       ! 
    159       IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 
    160          CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
    161       ELSE 
    162          ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???) 
    163          ! -------------------------------------------------------- 
    164          DO jk = 1, jpk 
    165             DO jj = 1, jpj 
    166                DO ji = 1, jpi 
    167                   ztmas   = tmask(ji,jj,jk) 
    168                   ztmas1  = 1. - tmask(ji,jj,jk) 
    169                   zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    170                   zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    171                   zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    172                   hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    173                END DO 
    174             END DO 
    175          END DO 
    176       ENDIF 
    177       CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )  
    178       IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN 
    179          CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  ) 
    180       ELSE 
    181          xksimax(:,:) = xksi(:,:) 
    182       ENDIF 
    183 #endif 
    184 #if defined key_cfc 
    185       DO jn = jp_cfc0, jp_cfc1 
    186          CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )  
    187       END DO 
    188 #endif 
    189 #if defined key_c14b 
    190       CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn) , qint_c14(:,:) )  
    191 #endif 
    192 #if defined key_my_trc 
    193 #endif 
    194        
     146         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
     147      END DO 
     148 
     149      DO jn = 1, jptra 
     150         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
     151      END DO 
     152 
     153      IF( lk_lobster )   CALL trc_rst_read_lobster( numrtr )      ! LOBSTER bio-model 
     154      IF( lk_pisces  )   CALL trc_rst_read_pisces ( numrtr )      ! PISCES  bio-model 
     155      IF( lk_cfc     )   CALL trc_rst_read_cfc    ( numrtr )      ! CFC     tracers 
     156      IF( lk_c14b    )   CALL trc_rst_read_c14b   ( numrtr )      ! C14 bomb  tracer 
     157      IF( lk_my_trc  )   CALL trc_rst_read_my_trc ( numrtr )      ! MY_TRC  tracers 
     158 
    195159      CALL iom_close( numrtr ) 
    196160      ! 
    197161   END SUBROUTINE trc_rst_read 
    198  
    199162 
    200163   SUBROUTINE trc_rst_wri( kt ) 
    … …  
    218181      CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 ) 
    219182 
    220       ! prognostic variables 
    221       ! -------------------- 
     183      ! prognostic variables  
     184      ! --------------------  
    222185      DO jn = 1, jptra 
    223186         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    … …  
    228191      END DO 
    229192 
    230 #if defined key_lobster 
    231          CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
    232          CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
    233 #endif 
    234 #if defined key_pisces  
    235          CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) ) 
    236          CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 
    237          CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 
    238 #endif 
    239 #if defined key_cfc 
    240          DO jn = jp_cfc0, jp_cfc1 
    241             CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
    242          END DO 
    243 #endif 
    244 #if defined key_c14b 
    245          CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_c14(:,:) ) 
    246 #endif 
    247 #if defined key_my_trc 
    248 #endif 
    249        
     193      IF( lk_lobster )   CALL trc_rst_wri_lobster( kt, nitrst, numrtw )      ! LOBSTER bio-model 
     194      IF( lk_pisces  )   CALL trc_rst_wri_pisces ( kt, nitrst, numrtw )      ! PISCES  bio-model 
     195      IF( lk_cfc     )   CALL trc_rst_wri_cfc    ( kt, nitrst, numrtw )      ! CFC     tracers 
     196      IF( lk_c14b    )   CALL trc_rst_wri_c14b   ( kt, nitrst, numrtw )      ! C14 bomb  tracer 
     197      IF( lk_my_trc  )   CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw )      ! MY_TRC  tracers 
     198 
    250199      IF( kt == nitrst ) THEN 
    251200          CALL trc_rst_stat            ! statistics 
    … …  
    256205      ENDIF 
    257206      ! 
    258    END SUBROUTINE trc_rst_wri 
     207   END SUBROUTINE trc_rst_wri  
     208 
    259209 
    260210   SUBROUTINE trc_rst_cal( kt, cdrw ) 
    … …  
    329279           WRITE(numout,*) 
    330280         ENDIF 
     281         ! 
     282         CALL day_init          ! compute calendar 
     283         ! 
    331284#endif 
    332285 
    … …  
    347300   END SUBROUTINE trc_rst_cal 
    348301 
    349 # if defined key_pisces  
    350  
    351    SUBROUTINE pis_dmp_ini  
    352       !!---------------------------------------------------------------------- 
    353       !!                    ***  pis_dmp_ini  *** 
    354       !! 
    355       !! ** purpose  : Relaxation of some tracers 
    356       !!---------------------------------------------------------------------- 
    357       INTEGER  :: ji, jj, jk   
    358       REAL(wp) ::  & 
    359          alkmean = 2426. ,  & ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    360          po4mean = 2.165 ,  & ! mean value of phosphates 
    361          no3mean = 30.90 ,  & ! mean value of nitrate 
    362          siomean = 91.51      ! mean value of silicate 
    363        
    364       REAL(wp) ::   zvol, ztrasum 
    365  
    366  
    367       IF(lwp)  WRITE(numout,*) 
    368  
    369       IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
    370          !                                                    ! --------------------------- ! 
    371          ! set total alkalinity, phosphate, NO3 & silicate 
    372  
    373          ! total alkalinity 
    374          ztrasum = 0.e0              
    375          DO jk = 1, jpk 
    376             DO jj = 1, jpj 
    377                DO ji = 1, jpi 
    378                   zvol = cvol(ji,jj,jk) 
    379 #  if defined key_off_degrad 
    380                   zvol = zvol * facvol(ji,jj,jk) 
    381 #  endif 
    382                   ztrasum = ztrasum + trn(ji,jj,jk,jptal) * zvol 
    383                END DO 
    384             END DO 
    385          END DO 
    386          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    387           
    388          ztrasum = ztrasum / areatot * 1.e6 
    389          IF(lwp) WRITE(numout,*) '       TALK mean : ', ztrasum 
    390          trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum 
    391              
    392          ! phosphate 
    393          ztrasum = 0.e0 
    394          DO jk = 1, jpk 
    395             DO jj = 1, jpj 
    396                DO ji = 1, jpi 
    397                   zvol = cvol(ji,jj,jk) 
    398 #  if defined key_off_degrad 
    399                   zvol = zvol * facvol(ji,jj,jk) 
    400 #  endif 
    401                   ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * zvol 
    402                END DO 
    403             END DO 
    404          END DO 
    405          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    406           
    407          ztrasum = ztrasum / areatot * 1.e6 / 122. 
    408          IF(lwp) WRITE(numout,*) '       PO4  mean : ', ztrasum 
    409          trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum 
    410          
    411          ! Nitrates           
    412          ztrasum = 0.e0 
    413          DO jk = 1, jpk 
    414             DO jj = 1, jpj 
    415                DO ji = 1, jpi 
    416                   zvol = cvol(ji,jj,jk) 
    417 #  if defined key_off_degrad 
    418                   zvol = zvol * facvol(ji,jj,jk) 
    419 #  endif 
    420                   ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * zvol 
    421                END DO 
    422             END DO 
    423          END DO 
    424          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    425           
    426          ztrasum = ztrasum / areatot * 1.e6 / 7.6 
    427          IF(lwp) WRITE(numout,*) '       NO3  mean : ', ztrasum 
    428          trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum 
    429           
    430          ! Silicate 
    431          ztrasum = 0.e0 
    432          DO jk = 1, jpk 
    433             DO jj = 1, jpj 
    434                DO ji = 1, jpi 
    435                   zvol = cvol(ji,jj,jk) 
    436 #  if defined key_off_degrad 
    437                   zvol = zvol * facvol(ji,jj,jk) 
    438 #  endif 
    439                   ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * zvol 
    440                END DO 
    441             END DO 
    442          END DO 
    443          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    444          ztrasum = ztrasum / areatot * 1.e6 
    445          IF(lwp) WRITE(numout,*) '       SiO3 mean : ', ztrasum 
    446          trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum )  
    447          ! 
    448       ENDIF 
    449  
    450 !#if defined key_kriest 
    451 !     !! Initialize number of particles from a standart restart file 
    452 !     !! The name of big organic particles jpgoc has been only change 
    453 !     !! and replace by jpnum but the values here are concentration 
    454 !     trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum) 
    455 !     trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 
    456 !#endif 
    457  
    458    END SUBROUTINE pis_dmp_ini 
    459  
    460 #endif 
    461       !!---------------------------------------------------------------------- 
    462302 
    463303   SUBROUTINE trc_rst_stat 

  • branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r1656 r2007  
    11MODULE trcwri 
    2    !!====================================================================== 
     2   !!=================================================================================== 
    33   !!                       *** MODULE trcwri *** 
    4    !!    TOP :   Output of passive tracers  
    5    !!====================================================================== 
    6    !!             1.0  !   
    7    !!                  !  2009-05 (C. Ethe ) 
     4   !!    TOP :   Output of passive tracers 
     5   !!==================================================================================== 
     6   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
     7   !!                  !  2010-03 (C. Ethe, R. Seferian ) Add the tracer transport trends 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_top &&  defined key_iomput 
    … …  
    1111   !!   'key_top' && 'key_iomput'                              TOP models 
    1212   !!---------------------------------------------------------------------- 
    13    !! trc_wri     :  outputs of concentration fields 
     13   !! trc_wri_trc   :  outputs of concentration fields 
     14   !! trc_wri_trd   :  outputs of transport trends 
    1415   !!---------------------------------------------------------------------- 
     16   USE dom_oce         ! ocean space and time domain variables 
     17   USE oce_trc 
     18   USE trp_trc 
    1519   USE trc 
     20   USE trdmld_trc_oce, ONLY : luttrd 
    1621   USE iom 
    1722#if defined key_off_tra 
    … …  
    3540CONTAINS 
    3641 
    37    SUBROUTINE trc_wri( kt )   
     42   SUBROUTINE trc_wri( kt ) 
    3843      !!--------------------------------------------------------------------- 
    3944      !!                     ***  ROUTINE trc_wri  *** 
     45      !!  
     46      !! ** Purpose :   output passive tracers fields and dynamical trends 
     47      !!--------------------------------------------------------------------- 
     48      INTEGER, INTENT( in ) :: kt 
     49      !!--------------------------------------------------------------------- 
     50 
     51      ! 
     52      CALL iom_setkt  ( kt + ndttrc - 1 )       ! set the passive tracer time step 
     53      CALL trc_wri_trc( kt              )       ! outputs for tracer concentration 
     54      CALL trc_wri_trd( kt              )       ! outputs for dynamical trends 
     55      CALL iom_setkt  ( kt              )       ! set the model time step 
     56      ! 
     57   END SUBROUTINE trc_wri 
     58 
     59   SUBROUTINE trc_wri_trc( kt )   
     60      !!--------------------------------------------------------------------- 
     61      !!                     ***  ROUTINE trc_wri_trc  *** 
    4062      !! 
    4163      !! ** Purpose :   output passive tracers fields  
    … …  
    4365      INTEGER, INTENT( in ) :: kt       ! ocean time-step 
    4466      INTEGER               :: jn 
    45       CHARACTER (len=20)    :: cltra 
     67      CHARACTER (len=20)    :: cltra, cltras 
    4668#if defined key_off_tra 
    4769      CHARACTER (len=40) :: clhstnam 
    4870      INTEGER ::   inum = 11            ! temporary logical unit 
    4971#endif 
    50  
    5172      !!--------------------------------------------------------------------- 
    5273  
    53       ! Initialisation 
    54       ! -------------- 
    55  
    56       CALL iom_setkt( kt + ndttrc - 1 ) ! set the passive tracer time step 
    57  
    5874#if defined key_off_tra 
    5975      IF( kt == nittrc000 ) THEN 
    … …  
    6783      ENDIF 
    6884#endif 
    69  
    70  
    7185      ! write the tracer concentrations in the file 
    7286      ! --------------------------------------- 
    … …  
    7690      END DO 
    7791      ! 
    78       CALL iom_setkt( kt )       ! set the model time step 
     92   END SUBROUTINE trc_wri_trc 
    7993 
     94# if defined key_trc_diatrd 
     95 
     96   SUBROUTINE trc_wri_trd( kt ) 
     97      !!---------------------------------------------------------------------- 
     98      !!                     ***  ROUTINE trc_wri_trd  *** 
     99      !! 
     100      !! ** Purpose :   output of passive tracer : advection-diffusion trends 
     101      !! 
     102      !!---------------------------------------------------------------------- 
     103      INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
     104      !! 
     105      CHARACTER (len=3) ::   cltra 
     106      INTEGER  ::   jn, jl, ikn 
     107      !!---------------------------------------------------------------------- 
     108 
     109      DO jn = 1, jptra 
     110         IF( luttrd(jn) ) THEN 
     111            ikn = ikeep(jn) 
     112            DO jl = 1, jpdiatrc 
     113               IF( jl == jptrc_xad ) WRITE (cltra,"(3a)") 'XAD' ! x advection for tracer 
     114               IF( jl == jptrc_yad ) WRITE (cltra,"(3a)") 'YAD'  ! y advection for tracer 
     115               IF( jl == jptrc_zad ) WRITE (cltra,"(3a)") 'ZAD'  ! z advection for tracer 
     116               IF( jl == jptrc_xdf ) WRITE (cltra,"(3a)") 'XDF'  ! x diffusion for tracer 
     117               IF( jl == jptrc_ydf ) WRITE (cltra,"(3a)") 'YDF'  ! y diffusion for tracer 
     118               IF( jl == jptrc_zdf ) WRITE (cltra,"(3a)") 'ZDF'  ! z diffusion for tracer 
     119# if defined key_trcldf_eiv 
     120               IF( jl == jptrc_xei ) WRITE (cltra,"(3a)") 'XGV'  ! x gent velocity for tracer 
     121               IF( jl == jptrc_yei ) WRITE (cltra,"(3a)") 'YGV'  ! y gent velocity for tracer 
     122               IF( jl == jptrc_zei ) WRITE (cltra,"(3a)") 'ZGV'  ! z gent velocity for tracer 
     123# endif 
     124# if defined key_trcdmp 
     125               IF( jl == jptrc_dmp ) WRITE (cltra,"(3a)") 'DMP'  ! damping 
     126# endif 
     127               IF( jl == jptrc_sbc ) WRITE (cltra,"(3a)") 'SBC'  ! surface boundary conditions 
     128               ! write the trends 
     129               CALL iom_put( cltra, trtrd(:,:,:,ikn,jl) ) 
     130            END DO 
     131         END IF 
     132      END DO 
    80133      ! 
    81    END SUBROUTINE trc_wri 
     134   END SUBROUTINE trc_wri_trd 
    82135 
     136# else 
     137   SUBROUTINE trc_wri_trd( kt )                      ! Dummy routine 
     138      INTEGER, INTENT ( in ) ::   kt 
     139   END SUBROUTINE trc_wri_trd 
     140#endif 
    83141#else 
    84142   !!---------------------------------------------------------------------- 
    … …  
    90148   INTEGER, INTENT(in) :: kt 
    91149   END SUBROUTINE trc_wri 
    92  
    93150#endif 
    94151 
Note: See TracChangeset for help on using the changeset viewer.