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 790 for branches/dev_001_GM – NEMO

Changeset 790 for branches/dev_001_GM


Ignore:
Timestamp:
2008-01-12T11:10:18+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - complete theprevious comit with omitted routines

Location:
branches/dev_001_GM/NEMO
Files:
17 edited
1 copied

Legend:

Unmodified
Added
Removed

  • branches/dev_001_GM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r719 r790  
    11MODULE dom_oce 
     2   !!====================================================================== 
     3   !!                       ***  MODULE dom_oce  *** 
     4   !! ** Purpose :   Define in memory all the ocean space domain variables 
     5   !!====================================================================== 
     6   !! History :  1.0  !  05-10  (A. Beckmann, G. Madec)  reactivate s-coordinate  
    27   !!---------------------------------------------------------------------- 
    3    !!                       ***  MODULE dom_oce  *** 
    4    !!        
    5    !! ** Purpose :   Define in memory all the ocean space domain variables 
     8   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2007)  
     9   !! $Id:$  
     10   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    611   !!---------------------------------------------------------------------- 
    7    !! History : 
    8    !!   9.0  !  05-10  (A. Beckmann, G. Madec)  reactivate s-coordinate  
    9    !!---------------------------------------------------------------------- 
    10    !!  OPA 9.0 , LOCEAN-IPSL (2006)  
    11    !! $Header$  
    12    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    13    !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1512   USE par_oce      ! ocean parameters 
    1613 
    … …  
    2219   !! space domain parameters 
    2320   !! ----------------------- 
    24    LOGICAL, PUBLIC ::   &   !: 
    25       lzoom      =  .FALSE. ,   &  !: zoom flag 
    26       lzoom_e    =  .FALSE. ,   &  !: East  zoom type flag 
    27       lzoom_w    =  .FALSE. ,   &  !: West  zoom type flag 
    28       lzoom_s    =  .FALSE. ,   &  !: South zoom type flag 
    29       lzoom_n    =  .FALSE. ,   &  !: North zoom type flag 
    30       lzoom_arct =  .FALSE. ,   &  !: ORCA    arctic zoom flag 
    31       lzoom_anta =  .FALSE.        !: ORCA antarctic zoom flag 
     21   LOGICAL, PUBLIC ::   lzoom      =  .FALSE.      !: zoom flag 
     22   LOGICAL, PUBLIC ::   lzoom_e    =  .FALSE.      !: East  zoom type flag 
     23   LOGICAL, PUBLIC ::   lzoom_w    =  .FALSE.      !: West  zoom type flag 
     24   LOGICAL, PUBLIC ::   lzoom_s    =  .FALSE.      !: South zoom type flag 
     25   LOGICAL, PUBLIC ::   lzoom_n    =  .FALSE.      !: North zoom type flag 
     26   LOGICAL, PUBLIC ::   lzoom_arct =  .FALSE.      !: ORCA    arctic zoom flag 
     27   LOGICAL, PUBLIC ::   lzoom_anta =  .FALSE.      !: ORCA antarctic zoom flag 
    3228 
    33    INTEGER, PUBLIC ::           & !!: namdom : space domain (bathymetry, mesh) 
    34       ntopo   =  0 ,            &  !: = 0/1 ,compute/read the bathymetry file 
    35       ngrid   =  0 ,            &  !: = 0/1, compute/read the horizontal mesh file 
    36       nmsh    =  0                 !: = 1 create a mesh-mask file 
     29   !                                              !!! namdom : space domain (bathymetry, mesh) 
     30   INTEGER, PUBLIC ::   ntopo   =  0               !: = 0/1 ,compute/read the bathymetry file 
     31   INTEGER, PUBLIC ::   ngrid   =  0               !: = 0/1, compute/read the horizontal mesh file 
     32   INTEGER, PUBLIC ::   nmsh    =  0               !: = 1 create a mesh-mask file 
    3733 
    38    INTEGER, PUBLIC ::         &   !: 
    39       ! domain parameters linked to mpp 
    40       nperio,          &  !: type of lateral boundary condition 
    41       nimpp, njmpp,    &  !: i- & j-indexes for mpp-subdomain left bottom 
    42       nreci, nrecj,    &  !: overlap region in i and j 
    43       nproc,           &  !: number for local processor 
    44       narea,           &  !: number for local area 
    45       nbondi, nbondj,  &  !: mark of i- and j-direction local boundaries 
    46       npolj,           &  !: north fold mark (0, 3 or 4) 
    47       nlci, nlcj,      &  !: i- & j-dimensions of the local subdomain 
    48       nldi, nlei,      &  !: first and last indoor i- and j-indexes 
    49       nldj, nlej,      &  !: 
    50       noea, nowe,      &  !: index of the local neighboring processors in 
    51       noso, nono,      &  !: east, west, south and north directions 
    52       npne, npnw,      &  !: index of north east and north west processor 
    53       npse, npsw,      &  !: index of south east and south west processor 
    54       nbne, nbnw,      &  !: logical of north east & north west processor 
    55       nbse, nbsw,      &  !: logical of south east & south west processor 
    56       nidom               !: ??? 
     34   !                                              !!! domain parameters linked to mpp 
     35   INTEGER, PUBLIC ::   nperio                     !: type of lateral boundary condition 
     36   INTEGER, PUBLIC ::   nimpp , njmpp              !: i- & j-indexes for mpp-subdomain left bottom 
     37   INTEGER, PUBLIC ::   nreci , nrecj              !: overlap region in i and j 
     38   INTEGER, PUBLIC ::   nproc                      !: number for local processor 
     39   INTEGER, PUBLIC ::   narea                      !: number for local area 
     40   INTEGER, PUBLIC ::   nbondi, nbondj             !: mark of i- and j-direction local boundaries 
     41   INTEGER, PUBLIC ::   npolj                      !: north fold mark (0, 3 or 4) 
     42   INTEGER, PUBLIC ::   nlci  , nlcj               !: i- & j-dimensions of the local subdomain 
     43   INTEGER, PUBLIC ::   nldi  , nlei               !: first and last indoor i- and j-indexes 
     44   INTEGER, PUBLIC ::   nldj  , nlej               !: 
     45   INTEGER, PUBLIC ::   noea  , nowe               !: index of the local neighboring processors in 
     46   INTEGER, PUBLIC ::   noso  , nono               !: east, west, south and north directions 
     47   INTEGER, PUBLIC ::   npne  , npnw               !: index of north east and north west processor 
     48   INTEGER, PUBLIC ::   npse  , npsw               !: index of south east and south west processor 
     49   INTEGER, PUBLIC ::   nbne  , nbnw               !: logical of north east & north west processor 
     50   INTEGER, PUBLIC ::   nbse  , nbsw               !: logical of south east & south west processor 
     51   INTEGER, PUBLIC ::   nidom                      !: ??? 
    5752 
    58    INTEGER, PUBLIC, DIMENSION(jpi) ::   &   !: 
    59       mig                 !: local  ==> global  domain i-indice 
    60    INTEGER, PUBLIC, DIMENSION(jpj) ::   &   !: 
    61       mjg                 !: local  ==> global  domain j-indice 
    62    INTEGER, PUBLIC, DIMENSION( jpidta ) ::   &  !:  !!bug ==> other solution? 
    63       mi0, mi1            !: global ==> local domain i-indice 
    64       !                   !  (mi0=1 and mi1=0 if the global indice is not in the local domain) 
    65    INTEGER, PUBLIC, DIMENSION( jpjdta ) ::   &  !: 
    66       mj0, mj1            !: global ==> local domain j-indice 
    67       !                   ! (mi0=1 and mi1=0 if the global indice is not in the local domain) 
     53   INTEGER, PUBLIC, DIMENSION(jpi)    ::   mig        !: local  ==> global  domain i-indice 
     54   INTEGER, PUBLIC, DIMENSION(jpj)    ::   mjg        !: local  ==> global  domain j-indice 
     55   INTEGER, PUBLIC, DIMENSION(jpidta) ::   mi0, mi1   !: global ==> local domain i-indice  (if the global indice is 
     56   !                                                  !  not in the local domain then mi0=1 and mi1=0) 
     57   !                                                  !!gm bug ==> other solution? 
     58   INTEGER, PUBLIC, DIMENSION(jpjdta) ::   mj0, mj1   !: global ==> local domain j-indice  (if the global indice is 
     59   !                                                  ! not in the local domain then mj0=1 and mj1=0) 
    6860 
    69    INTEGER, PUBLIC, DIMENSION(jpnij) ::   &  !: 
    70       nimppt, njmppt,  &  !: i-, j-indexes for each processor 
    71       ibonit, ibonjt,  &  !: i-, j- processor neighbour existence 
    72       nlcit , nlcjt,   &  !: dimensions of every subdomain 
    73       nldit , nldjt,   &  !: first, last indoor index for each i-domain 
    74       nleit , nlejt       !: first, last indoor index for each j-domain 
     61   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   nimppt, njmppt   !: i-, j-indexes for each processor 
     62   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   ibonit, ibonjt   !: i-, j- processor neighbour existence 
     63   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   nlcit , nlcjt    !: dimensions of every subdomain 
     64   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   nldit , nldjt    !: first, last indoor index for each i-domain 
     65   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   nleit , nlejt    !: first, last indoor index for each j-domain 
    7566 
    7667   !!---------------------------------------------------------------------- 
    … …  
    7869   !! --------------------------------------------------------------------- 
    7970 
    80    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    81       glamt, glamu,    &  !: longitude of t-, u-, v- and f-points (degre) 
    82       glamv, glamf,    &  !: 
    83       gphit, gphiu,    &  !: latitude  of t-, u-, v- and f-points (degre) 
    84       gphiv, gphif,    &  !: 
    85       e1t, e2t,        &  !: horizontal scale factors at t-point (m) 
    86       e1u, e2u,        &  !: horizontal scale factors at u-point (m) 
    87       e1v, e2v,        &  !: horizontal scale factors at v-point (m) 
    88       e1f, e2f,        &  !: horizontal scale factors at f-point (m) 
    89       ff                  !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
     71   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   glamt, glamu   !: longitude of t-, u-, v- and f-points (degre) 
     72   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   glamv, glamf   !: 
     73   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre) 
     74   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gphiv, gphif   !: 
     75   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1t  , e2t     !: horizontal scale factors at t-point (m) 
     76   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1u  , e2u     !: horizontal scale factors at u-point (m) 
     77   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1v  , e2v     !: horizontal scale factors at v-point (m) 
     78   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1f  , e2f     !: horizontal scale factors at f-point (m) 
     79   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
    9080 
    9181   !!---------------------------------------------------------------------- 
    9282   !! vertical coordinate and scale factors 
    9383   !! -------------------------------------- 
    94  
    95    LOGICAL, PUBLIC ::           & !!: namzgr : vertical coordinate 
    96       ln_zco     =  .TRUE.  ,   &  !: z-coordinate - full step 
    97       ln_zps     =  .FALSE. ,   &  !: z-coordinate - partial step 
    98       ln_sco     =  .FALSE.        !: s-coordinate or hybrid z-s coordinate 
    99  
     84   !                                           !!* namzgr : vertical coordinate * 
     85   LOGICAL, PUBLIC ::   ln_zco     =  .TRUE.    !: z-coordinate - full step 
     86   LOGICAL, PUBLIC ::   ln_zps     =  .FALSE.   !: z-coordinate - partial step 
     87   LOGICAL, PUBLIC ::   ln_sco     =  .FALSE.   !: s-coordinate or hybrid z-s coordinate 
    10088#if defined key_zco 
    10189   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .TRUE.    !: z-coordinate flag (1D arrays) 
    … …  
    10593   !! All coordinates 
    10694   !! --------------- 
    107    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    108       gdep3w        ,    &  !: depth of T-points (sum of e3w) (m) 
    109       gdept , gdepw ,    &  !: analytical depth at T-W  points (m) 
    110       e3v   , e3f   ,    &  !: analytical vertical scale factors at  V--F 
    111       e3t   , e3u   ,    &  !:                                       T--U  points (m) 
    112       e3vw          ,    &  !: analytical vertical scale factors at  VW-- 
    113       e3w   , e3uw          !:                                        W--UW  points (m) 
     95   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdep3w          !: depth of T-points (sum of e3w) (m) 
     96   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdept , gdepw   !: depth at T-W  points (m) 
     97   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3v   , e3f     !: vertical scale factors at  V--F 
     98   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3t   , e3u     !:                            T--U  points (m) 
     99   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3vw            !: vertical scale factors at VW-- 
     100   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3w   , e3uw    !:                            W--UW  points (m) 
    114101#endif 
    115102#if defined key_vvl 
    … …  
    118105   !! All coordinates 
    119106   !! --------------- 
    120    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    121       gdep3w_1        ,  &  !: depth of T-points (sum of e3w) (m) 
    122       gdept_1, gdepw_1,  &  !: analytical depth at T-W  points (m) 
    123       e3v_1  , e3f_1  ,  &  !: analytical vertical scale factors at  V--F 
    124       e3t_1  , e3u_1  ,  &  !:                                       T--U  points (m) 
    125       e3vw_1          ,  &  !: analytical vertical scale factors at  VW-- 
    126       e3w_1  , e3uw_1       !:                                       W--UW  points (m) 
     107   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdep3w_1          !: depth of T-points (sum of e3w) (m) 
     108   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdept_1, gdepw_1  !: depth at T-W  points (m) 
     109   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3v_1  , e3f_1    !: vertical scale factors at  V--F 
     110   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3t_1  , e3u_1    !:                            T--U  points (m) 
     111   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3vw_1            !: vertical scale factors at VW-- 
     112   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3w_1  , e3uw_1   !:                            W--UW  points (m) 
    127113#else 
    128114   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag 
    129115#endif 
    130    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    131       hur, hvr,          &  !: inverse of u and v-points ocean depth (1/m) 
    132       hu , hv               !: depth at u- and v-points (meters) 
     116   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hur, hvr              !: inverse of u and v-points ocean depth (1/m) 
     117   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hu , hv               !: depth at u- and v-points (meters) 
    133118 
    134119   !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 
    135120   !! =-----------------====------ 
    136    REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !: 
    137       gdept_0, gdepw_0,       &  !: reference depth of t- and w-points (m) 
    138       e3t_0  , e3w_0             !: reference vertical scale factors at T- and W-pts (m) 
     121   REAL(wp), PUBLIC, DIMENSION(jpk) ::   gdept_0, gdepw_0          !: reference depth of t- and w-points (m) 
     122   REAL(wp), PUBLIC, DIMENSION(jpk) ::   e3t_0  , e3w_0            !: reference vertical scale factors at T- & W-pts (m) 
    139123 
    140124   !! z-coordinate with partial steps 
    141125   !! =-----------------=======------ 
    142    REAL(wp), PUBLIC ::      & !!: * namelist namdom * 
    143       e3zps_min = 5.0_wp,   &  !: miminum thickness for partial steps (meters) 
    144       e3zps_rat = 0.1_wp       !: minimum thickness ration for partial steps 
     126   !                          !!: * namelist namdom * 
     127   REAL(wp), PUBLIC ::   e3zps_min = 5.0_wp       !: miminum thickness for partial steps (meters) 
     128   REAL(wp), PUBLIC ::   e3zps_rat = 0.1_wp       !: minimum thickness ration for partial steps 
    145129 
    146    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    147       hdept, hdepw, e3tp, e3wp   !: ??? 
     130   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hdept, hdepw, e3tp, e3wp   !: ??? 
    148131 
    149132   !! s-coordinate and hybrid z-s-coordinate 
    150133   !! =----------------======--------------- 
    151    REAL(wp), PUBLIC, DIMENSION(jpk) ::   &   !: 
    152       gsigt, gsigw ,   &  !: model level depth coefficient at t-, w-levels (analytic) 
    153       gsi3w        ,   &  !: model level depth coefficient at w-level (sum of gsigw) 
    154       esigt, esigw        !: vertical scale factor coef. at t-, w-levels 
     134   REAL(wp), PUBLIC, DIMENSION(jpk) ::   gsigt, gsigw   !: model level depth coefficient at t-, w-levels (analytic) 
     135   REAL(wp), PUBLIC, DIMENSION(jpk) ::   gsi3w          !: model level depth coefficient at w-level (sum of gsigw) 
     136   REAL(wp), PUBLIC, DIMENSION(jpk) ::   esigt, esigw   !: vertical scale factor coef. at t-, w-levels 
    155137 
    156    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    157       hbatv , hbatf ,   &  !: ocean depth at the vertical of  V--F 
    158       hbatt , hbatu ,   &  !:                                 T--U  points (m) 
    159       scosrf, scobot,   &  !:  ocean surface and bottom topographies (if deviating from coordinate surfaces in HYBRID) 
    160       hifv  , hiff  ,   &  !: interface depth between stretching    at  V--F 
    161       hift  , hifu         !: and quasi-uniform spacing                 T--U  points (m) 
     138   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hbatv , hbatf   !: ocean depth at the vertical of  V--F 
     139   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hbatt , hbatu   !:                                 T--U  points (m) 
     140   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   scosrf, scobot  !:  ocean surface and bottom topographies 
     141   !                                                         !  (if deviating from coordinate surfaces in HYBRID) 
     142   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hifv  , hiff    !: interface depth between stretching at  V--F 
     143   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hift  , hifu    !: and quasi-uniform spacing              T--U  points (m) 
    162144 
    163145   !!---------------------------------------------------------------------- 
    … …  
    165147   !! ----------------- 
    166148 
    167    INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    168       mbathy     !: number of ocean level (=0, 1, ... , jpk-1) 
     149   INTEGER , PUBLIC, DIMENSION(jpi,jpj)     ::   mbathy         !: number of ocean level (=0, 1, ... , jpk-1) 
     150   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   bathy          !: ocean depth (meters) 
     151   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   tmask_i        !: interior domain T-point mask 
     152   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   bmask          !: land/ocean mask of barotropic stream function 
     153   REAL(wp), PUBLIC, DIMENSION(jpiglo)      ::   tpol, fpol     !: north fold mask (nperio= 3 or 4) 
     154   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   vmask, fmask   !: land/ocean mask at V--F 
     155   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   tmask, umask   !:             and at V--U  points 
    169156 
    170    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    171       bathy  ,         &  !: ocean depth (meters) 
    172       tmask_i,         &  !: interior domain T-point mask 
    173       bmask               !: land/ocean mask of barotropic stream function 
    174  
    175    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    176       tmask, umask,    &  !: land/ocean mask at T-, U-, V- and F-points 
    177       vmask, fmask        !: 
    178  
    179    REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   &   !: 
    180       tpol, fpol          !: north fold mask (nperio= 3 or 4) 
    181157 
    182158#if defined key_noslip_accurate 
    183    INTEGER, PUBLIC, DIMENSION(4,jpk) ::   &   !: 
    184       npcoa               !: ??? 
    185    INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) ::   &   !: 
    186       nicoa,           &  !: ??? 
    187       njcoa               !: ??? 
     159   INTEGER, PUBLIC, DIMENSION(            4,jpk) ::   npcoa          !: ??? 
     160   INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) ::   nicoa, njcoa   !: ??? 
    188161#endif 
    189162 
    … …  
    191164   !! time domain 
    192165   !!---------------------------------------------------------------------- 
    193    INTEGER, PUBLIC ::    & !!: * Namelist * ??? 
    194       nacc   = 0 ,       &  !: = 0/1 use of the acceleration of convergence technique 
    195       neuler                !: restart euler forward option (0=Euler) 
     166   !                                        !!! * Namelist * ??? 
     167   INTEGER, PUBLIC  ::   nacc   = 0          !: = 0/1 use of the acceleration of convergence technique 
     168   INTEGER, PUBLIC  ::   neuler              !: restart euler forward option (0=Euler) 
    196169 
     170   !                                        !!! * Namelist ??? * 
     171   REAL(wp), PUBLIC ::   rdt    = 3600._wp   !: time step for the dynamics (and tracer if nacc=0) 
     172   REAL(wp), PUBLIC ::   rdtmin = 3600._wp   !: minimum time step on tracers 
     173   REAL(wp), PUBLIC ::   rdtmax = 3600._wp   !: maximum time step on tracers 
     174   REAL(wp), PUBLIC ::   rdth   =  800._wp   !: depth variation of tracer step 
     175   REAL(wp), PUBLIC ::   rdtbt  =   90._wp   !: barotropic time step for the dynamics (lk_dynspg_ts=T) 
     176   REAL(wp), PUBLIC ::   atfp   =   0.1_wp   !: asselin time filter parameter 
     177   REAL(wp), PUBLIC ::   atfp1               !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    197178 
    198    REAL(wp), PUBLIC ::       & !!: * Namelist ??? * 
    199       rdt    = 3600._wp ,    &  !: time step for the dynamics (and tracer if nacc=0) 
    200       rdtmin = 3600._wp ,    &  !: minimum time step on tracers 
    201       rdtmax = 3600._wp ,    &  !: maximum time step on tracers 
    202       rdth   =  800._wp ,    &  !: depth variation of tracer step 
    203       rdtbt  =   90._wp ,    &  !: barotropic time step for the dynamics (lk_dynspg_ts=T) 
    204       atfp   = 0.1_wp   ,    &  !: asselin time filter parameter 
    205       atfp1                     !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    206  
    207    REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !: 
    208       rdttra                    !: vertical profile of tracer time step 
     179   REAL(wp), PUBLIC, DIMENSION(jpk) ::   rdttra   !: vertical profile of tracer time step 
    209180 
    210181   !!---------------------------------------------------------------------- 
    211182   !! cross land advection 
    212183   !!---------------------------------------------------------------------- 
    213  
    214    INTEGER, PUBLIC ::       & !!: namelist ??? 
    215       n_cla                    !: flag (0/1) for cross land advection to 
    216       !                        ! parameterize exchanges through straits 
     184   !                                        !!! * Namelist ??? * 
     185   INTEGER, PUBLIC ::   n_cla                !: flag (0/1) for cross land advection to 
     186      !                                      ! parameterize exchanges through straits 
    217187 
    218188#if defined key_agrif 
    … …  
    221191   !!---------------------------------------------------------------------- 
    222192   LOGICAL, PUBLIC :: spongedoneT = .FALSE.  !: ??? 
    223    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   & 
    224       zspe1ur, zspe2vr ,zspbtr2    !: ??? 
     193   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   zspe1ur, zspe2vr ,zspbtr2    !: ??? 
    225194   !!---------------------------------------------------------------------- 
    226195#endif 
    227196 
     197   !!====================================================================== 
    228198END MODULE dom_oce 

  • branches/dev_001_GM/NEMO/OPA_SRC/DOM/domzgr.F90

    r719 r790  
    11MODULE domzgr 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE domzgr   *** 
    44   !! Ocean initialization : domain initialization 
    5    !!============================================================================== 
     5   !!====================================================================== 
     6   !! History :  NEMO !  03-08  (G. Madec)  original code 
     7   !!            1.0  !  05-10  (A. Beckmann)  modifications for hybrid s-ccordinates 
     8   !!             -   !  06-04  (R. Benshila, G. Madec)  add zgr_zco routine 
     9   !!---------------------------------------------------------------------- 
    610 
    711   !!---------------------------------------------------------------------- 
    … …  
    1418   !!       zgr_zps      : z-coordinate with partial steps 
    1519   !!       zgr_sco      : s-coordinate 
    16    !!--------------------------------------------------------------------- 
    17    !! * Modules used 
     20   !!---------------------------------------------------------------------- 
    1821   USE oce             ! ocean dynamics and tracers 
    1922   USE dom_oce         ! ocean space and time domain 
    … …  
    2831   PRIVATE 
    2932 
    30    !! * Routine accessibility 
    3133   PUBLIC dom_zgr        ! called by dom_init.F90 
    3234 
    33    !! * Module variables 
    34       REAL(wp) ::          & !!: Namelist nam_zgr_sco 
    35       sbot_min =  300.  ,  &  !: minimum depth of s-bottom surface (>0) (m) 
    36       sbot_max = 5250.  ,  &  !: maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
    37       theta    =    6.0 ,  &  !: surface control parameter (0<=theta<=20) 
    38       thetb    =    0.75,  &  !: bottom control parameter  (0<=thetb<= 1) 
    39       r_max    =    0.15      !: maximum cut-off r-value allowed (0<r_max<1) 
    40  
    41  
     35   !                                 !!! * Namelist nam_zgr_sco * 
     36   REAL(wp) ::   sbot_min =  300.     !: minimum depth of s-bottom surface (>0) (m) 
     37   REAL(wp) ::   sbot_max = 5250.     !: maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
     38   REAL(wp) ::   theta    =    6.0    !: surface control parameter (0<=theta<=20) 
     39   REAL(wp) ::   thetb    =    0.75   !: bottom control parameter  (0<=thetb<= 1) 
     40   REAL(wp) ::   r_max    =    0.15   !: maximum cut-off r-value allowed (0<r_max<1) 
    4241  
    4342   !! * Substitutions 
    … …  
    4544#  include "vectopt_loop_substitute.h90" 
    4645   !!---------------------------------------------------------------------- 
    47    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     46   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     47   !! $Id:$  
     48   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4849   !!---------------------------------------------------------------------- 
    4950 
    … …  
    5859      !! 
    5960      !! ** Method  reference vertical coordinate 
    60       !! 
    61       !! ** Action :  
    62       !! 
    63       !! History : 
    64       !!   9.0  !  03-08  (G. Madec)  original code 
    65       !!   9.0  !  05-10  (A. Beckmann)  modifications for hybrid s-ccordinates 
    6661      !!---------------------------------------------------------------------- 
    6762      INTEGER ::   ioptio = 0      ! temporary integer 
    … …  
    7065      !!---------------------------------------------------------------------- 
    7166 
    72       ! Read Namelist nam_zgr : vertical coordinate' 
    73       ! --------------------- 
    74       REWIND ( numnam ) 
     67      REWIND ( numnam )                ! Read Namelist nam_zgr : vertical coordinate' 
    7568      READ   ( numnam, nam_zgr ) 
    7669 
    77       ! Parameter control and print 
    78       ! --------------------------- 
    79       ! Control print 
    80       IF(lwp) THEN 
     70      IF(lwp) THEN                     ! Control print 
    8171         WRITE(numout,*) 
    8272         WRITE(numout,*) 'dom_zgr : vertical coordinate' 
    … …  
    8878      ENDIF 
    8979 
    90       ! Check Vertical coordinate options 
     80      !                                ! Check Vertical coordinate options 
    9181      ioptio = 0 
    9282      IF( ln_zco ) ioptio = ioptio + 1 
    … …  
    131121      ENDIF 
    132122!!!bug gm 
    133  
     123      ! 
    134124   END SUBROUTINE dom_zgr 
    135125 
    … …  
    154144      !!              -  e3t_0, e3w_0    : scale factors at T- and W-levels (m) 
    155145      !! 
    156       !! Reference : 
    157       !!      Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. 
    158       !! 
    159       !! History : 
    160       !!   9.0  !  03-08  (G. Madec)  F90: Free form and module 
    161       !!---------------------------------------------------------------------- 
    162       !! * Local declarations 
    163       INTEGER  ::   jk                     ! dummy loop indices 
    164       REAL(wp) ::   zt, zw                 ! temporary scalars 
    165       REAL(wp) ::   & 
    166       zsur , za0, za1, zkth, zacr,      &  ! Values set from parameters in 
    167       zdzmin, zhmax                        ! par_CONFIG_Rxx.h90 
     146      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. 
     147      !!---------------------------------------------------------------------- 
     148      INTEGER  ::   jk                          ! dummy loop indices 
     149      REAL(wp) ::   zt, zw                      ! temporary scalars 
     150      REAL(wp) ::   zsur , za0, za1             ! value set from parameters  
     151      REAL(wp) ::   zkth, zacr, zdzmin, zhmax   !    "             " 
    168152      !!---------------------------------------------------------------------- 
    169153 
    … …  
    176160      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr 
    177161      ! 
    178        IF(  ppa1  == pp_to_be_computed  .AND.  & 
     162      IF(   ppa1  == pp_to_be_computed  .AND.  & 
    179163         &  ppa0  == pp_to_be_computed  .AND.  & 
    180164         &  ppsur == pp_to_be_computed           ) THEN 
    … …  
    183167             &                         *  (  LOG( COSH( (jpk - ppkth) / ppacr) )      & 
    184168             &                             - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
    185  
    186169         za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr ) 
    187170         zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  ) 
    188  
    189        ELSE 
    190          za1 = ppa1 ;       za0 = ppa0 ;          zsur = ppsur 
    191        ENDIF 
    192  
    193  
    194       ! Parameter print 
    195       ! --------------- 
    196       IF(lwp) THEN 
     171      ELSE 
     172         za1 = ppa1   ;   za0 = ppa0   ;   zsur = ppsur 
     173      ENDIF 
     174 
     175      IF(lwp) THEN                    ! control print 
    197176         WRITE(numout,*) 
    198177         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates' 
    … …  
    220199      ! Reference z-coordinate (depth - scale factor at T- and W-points) 
    221200      ! ====================== 
    222       IF( ppkth == 0.e0 ) THEN            !  uniform vertical grid        
    223  
     201      IF( ppkth == 0.e0 ) THEN            ! uniform vertical grid        
    224202         za1 = zhmax / FLOAT(jpk-1)  
    225203         DO jk = 1, jpk 
    … …  
    231209            e3t_0  (jk) =  za1 
    232210         END DO 
    233  
    234       ELSE 
    235  
     211      ELSE                                ! stretched vertical grid 
    236212         DO jk = 1, jpk 
    237213            zw = FLOAT( jk ) 
    … …  
    242218            e3t_0  (jk) =          za0      + za1        * TANH(      (zt-zkth)/zacr   ) 
    243219         END DO 
    244          gdepw_0(1) = 0.e0      ! force first w-level to be exactly at zero 
    245  
    246       ENDIF 
    247  
    248       ! Control and  print 
    249       ! ================== 
    250  
    251       IF(lwp) THEN 
     220         gdepw_0(1) = 0.e0                   ! force first w-level to be exactly at zero 
     221      ENDIF 
     222 
     223      IF(lwp) THEN                        ! Control and  print 
    252224         WRITE(numout,*) 
    253225         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:' 
    … …  
    255227         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk ) 
    256228      ENDIF 
    257  
     229      ! 
    258230      DO jk = 1, jpk 
    259231         IF( e3w_0(jk)  <= 0. .OR. e3t_0(jk)  <= 0. ) CALL ctl_stop( ' e3w or e3t =< 0 ' ) 
    260232         IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0. ) CALL ctl_stop( ' gdepw or gdept < 0 ' ) 
    261233      END DO 
    262  
     234      ! 
    263235   END SUBROUTINE zgr_z 
    264236 
    … …  
    297269      !! ** Action  : - mbathy: level bathymetry (in level index) 
    298270      !!              - bathy : meter bathymetry (in meters) 
    299       !! 
    300       !! History : 
    301       !!   9.0  !  03-08  (G. Madec)  Original code 
    302       !!   9.0  !  05-10  (A. Beckmann)  modifications for s-ccordinates 
    303       !!---------------------------------------------------------------------- 
    304       !! * Modules used 
     271      !!---------------------------------------------------------------------- 
    305272      USE iom 
    306273 
    307       !! * Local declarations 
    308       INTEGER ::   ji, jj, jl, jk       ! dummy loop indices 
    309       INTEGER ::   inum                 ! temporary logical unit 
    310       INTEGER  ::   & 
    311          ii_bump, ij_bump, ih           ! bump center position 
    312       INTEGER , DIMENSION(jpidta,jpjdta) ::   & 
    313          idta                           ! global domain integer data 
    314       REAL(wp) ::   & 
    315          r_bump, h_bump, h_oce,      &  ! bump characteristics  
    316          zi, zj, zh                     ! temporary scalars 
    317       REAL(wp), DIMENSION(jpidta,jpjdta) ::   & 
    318          zdta                           ! global domain scalar data 
     274      INTEGER  ::   ji, jj, jl, jk          ! dummy loop indices 
     275      INTEGER  ::   inum                    ! temporary logical unit 
     276      INTEGER  ::   ii_bump, ij_bump, ih    ! bump center position 
     277      REAL(wp) ::   r_bump, h_bump, h_oce   ! bump characteristics  
     278      REAL(wp) ::   zi, zj, zh                     ! temporary scalars 
     279      INTEGER , DIMENSION(jpidta,jpjdta) ::   idta   ! global domain integer data 
     280      REAL(wp), DIMENSION(jpidta,jpjdta) ::   zdta   ! global domain scalar data 
    319281      !!---------------------------------------------------------------------- 
    320282 
    … …  
    331293 
    332294         IF( ntopo == 0 ) THEN                        ! flat basin 
    333  
    334295            IF(lwp) WRITE(numout,*) 
    335296            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin' 
    336  
    337297            idta(:,:) = jpkm1                            ! flat basin  
    338298            zdta(:,:) = gdepw_0(jpk) 
    339299            h_oce     = gdepw_0(jpk) 
    340  
     300            ! 
    341301         ELSE                                         ! bump 
    342302            IF(lwp) WRITE(numout,*) 
    343303            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin with a bump' 
    344  
    345304            ii_bump = jpidta / 2           ! i-index of the bump center 
    346305            ij_bump = jpjdta / 2           ! j-index of the bump center 
    … …  
    361320               END DO 
    362321            END DO 
    363  
    364322            ! idta : 
    365323            IF( ln_sco ) THEN      ! s-coordinate (zsc       ): idta()=jpk 
    … …  
    478436      !! 
    479437      !! ** Action  : - update mbathy: level bathymetry (in level index) 
    480       !! 
    481       !! History : 
    482       !!   9.0  !  03-08  (G. Madec)  Original code 
    483       !!---------------------------------------------------------------------- 
    484       !! * Local variables 
     438      !!---------------------------------------------------------------------- 
    485439      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integers 
    486440      !!---------------------------------------------------------------------- 
    … …  
    523477         ! 
    524478      ENDIF 
    525  
     479      ! 
    526480   END SUBROUTINE zgr_bat_zoom 
    527481 
    … …  
    548502      !! ** Action  : - update mbathy: level bathymetry (in level index) 
    549503      !!              - update bathy : meter bathymetry (in meters) 
    550       !! 
    551       !! History : 
    552       !!   9.0  !  03-08  (G. Madec)  Original code 
    553       !!   9.0  !  05-10  (A. Beckmann)  modifications for s-ccordinates 
    554       !!---------------------------------------------------------------------- 
    555       !! * Local declarations 
    556       INTEGER ::   ji, jj, jl           ! dummy loop indices 
    557       INTEGER ::   & 
    558          icompt, ibtest, ikmax          ! temporary integers 
    559       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    560          zbathy                         ! temporary workspace 
     504      !!---------------------------------------------------------------------- 
     505      INTEGER ::   ji, jj, jl                    ! dummy loop indices 
     506      INTEGER ::   icompt, ibtest, ikmax         ! temporary integers 
     507      REAL(wp), DIMENSION(jpi,jpj) ::   zbathy   ! temporary workspace 
    561508      !!---------------------------------------------------------------------- 
    562509 
    … …  
    580527 
    581528         DO jl = 1, 2 
    582  
    583529            IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
    584530               mbathy( 1 ,:) = mbathy(jpim1,:) 
    … …  
    597543               END DO 
    598544            END DO 
    599  
    600          END DO 
    601          IF( icompt == 0 ) THEN 
    602             IF(lwp) WRITE(numout,*)'     no isolated ocean grid points' 
    603          ELSE 
    604             IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed' 
     545         END DO 
     546         ! 
     547         IF( icompt == 0 ) THEN   ;   IF(lwp) WRITE(numout,*)'     no isolated ocean grid points' 
     548         ELSE                     ;   IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed' 
    605549         ENDIF 
     550         ! 
    606551         IF( lk_mpp ) THEN 
    607552            zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    … …  
    610555         ENDIF 
    611556 
    612          ! 3.2 East-west cyclic boundary conditions 
     557         ! East-west cyclic boundary conditions 
    613558 
    614559         IF( nperio == 0 ) THEN 
    … …  
    661606               mbathy(:,:) = INT( zbathy(:,:) ) 
    662607            ENDIF 
    663  
     608            ! 
    664609         ENDIF 
    665  
     610         ! 
    666611      ENDIF 
    667612 
    … …  
    674619         END DO 
    675620      END DO 
    676       !!! test a faire:   ikmax = MAX( mbathy(:,:) )   ??? 
     621!!gm      !!! test a faire:   ikmax = MAX( mbathy(:,:) )   ??? 
    677622 
    678623      IF( ikmax > jpkm1 ) THEN 
    … …  
    694639         WRITE(numout,*) 
    695640      ENDIF 
    696  
     641      ! 
    697642   END SUBROUTINE zgr_bat_ctl 
    698643 
    … …  
    705650      !! 
    706651      !! ** Method  :   set 3D coord. arrays to reference 1D array if lk_zco=T 
    707       !! 
    708       !! History : 
    709       !!        !  06-04  (R. Benshila, G. Madec)  Original code  
    710652      !!---------------------------------------------------------------------- 
    711653      INTEGER  ::   jk 
    712654      !!---------------------------------------------------------------------- 
    713  
     655      ! 
    714656      IF( .NOT.lk_zco ) THEN 
    715657         DO jk = 1, jpk 
    … …  
    726668         END DO 
    727669      ENDIF 
    728  
     670      ! 
    729671   END SUBROUTINE zgr_zco 
    730  
    731672 
    732673 
    … …  
    769710      !!      schemes. 
    770711      !! 
    771       !! Reference : 
    772       !!      Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 
    773       !! 
    774       !! History : 
    775       !!        !  95-12  (G. Madec)  Original code : s vertical coordinate 
    776       !!        !  97-07  (G. Madec)  lbc_lnk call 
    777       !!        !  97-04  (J.-O. Beismann)  
    778       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    779       !!   9.0  !  05-10  (A. Beckmann)  new stretching function 
    780       !!---------------------------------------------------------------------- 
    781       !! * Local declarations 
     712      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 
     713      !!---------------------------------------------------------------------- 
    782714      INTEGER  ::   ji, jj, jk, jl 
    783       REAL(wp) ::   fssig, fsdsig, pfkk 
     715      REAL(wp) ::   fssigt, fssigw, pfkk 
    784716 
    785717      INTEGER  ::   iip1, ijp1, iim1, ijm1 
    786       REAL(wp) ::   & 
    787          fssigt, fssigw, zcoeft, zcoefw,   & 
    788          zrmax, ztaper 
    789  
    790       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    791          zenv, ztmp, zmsk, zri, zrj, zhbat 
     718!     REAL(wp) ::   zcoeft, zcoefw 
     719      REAL(wp) ::   zrmax, ztaper 
     720 
     721      REAL(wp), DIMENSION(jpi,jpj) ::   zenv, ztmp, zmsk, zri, zrj, zhbat 
    792722 
    793723      NAMELIST/nam_zgr_sco/ sbot_max, sbot_min, theta, thetb, r_max 
    … …  
    11201050      END DO 
    11211051 
    1122       IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
     1052      IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   & 
     1053         &                                        ' MAX '               , MAXVAL( mbathy(:,:) ) 
    11231054 
    11241055 
    … …  
    11291060      IF( lzoom )   CALL zgr_bat_zoom 
    11301061 
    1131       ! 2.4 Control print 
    1132  
    1133       IF(lwp) THEN 
     1062      IF(lwp) THEN                           ! Control print 
    11341063         WRITE(numout,*)  
    11351064         WRITE(numout,*) ' domzgr: vertical coefficients for model level' 
    … …  
    12021131      END DO 
    12031132!!bug gm    #endif 
    1204  
     1133      ! 
    12051134   END SUBROUTINE zgr_sco 
    12061135 

  • branches/dev_001_GM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r719 r790  
    9999               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    100100               va(ji,jj,jk) = va(ji,jj,jk) + zva 
    101 #if defined key_trddyn 
    102                utrd(ji,jj,jk,1) = zua                    ! save the horizontal advective trend of momentum 
    103                vtrd(ji,jj,jk,1) = zva  
    104 #endif 
    105101            END DO 
    106102         END DO 
    … …  
    109105      !                                                ! =============== 
    110106 
     107!!gm  momentum trend diagnostics is missing 
    111108 
    112109      ! II. Vertical advection 
    … …  
    158155         END DO 
    159156      END DO 
     157!!gm  momentum trend diagnostics is missing 
    160158 
    161159   END SUBROUTINE dyn_adv_cen2 

  • branches/dev_001_GM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r719 r790  
    191191               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    192192               va(ji,jj,jk) = va(ji,jj,jk) + zva 
    193 #if defined key_trddyn 
    194                utrd(ji,jj,jk,1) = zua                    ! save the horizontal advective trend of momentum 
    195                vtrd(ji,jj,jk,1) = zva  
    196 #endif 
    197193            END DO 
    198194         END DO 
    … …  
    201197      !                                                ! =============== 
    202198 
     199!!gm  momentum trend diagnostics is missing 
    203200 
    204201      ! II. Vertical advection 

  • branches/dev_001_GM/NEMO/OPA_SRC/SBC/ocesbc.F90

    r719 r790  
    44   !!                     Ocean surface boundary conditions 
    55   !!====================================================================== 
     6   !! History :   -   !  00-10  (O. Marti)  Original code 
     7   !!            1.0  !  02-12  (G. Madec)  F90: Free form and module 
     8   !!            2.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
     9   !!            2.4  !  08-01  (G. Madec)  suppress dmp (internal damping contribution) 
     10   !!---------------------------------------------------------------------- 
    611 
    712   !!---------------------------------------------------------------------- 
    … …  
    914   !!   oce_sbc_dmp : ??? 
    1015   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1216   USE oce            ! dynamics and tracers variables 
    1317   USE dom_oce        ! ocean space domain variables 
    … …  
    2024   USE flxmod         ! thermohaline fluxes 
    2125   USE flxrnf         ! runoffs forcing 
    22    USE tradmp         ! damping salinity trend 
    2326   USE dtatem         ! ocean temperature data 
    2427   USE dtasal         ! ocean salinity data 
    … …  
    4952      qrp ,         &  !: heat flux damping (w/m2) 
    5053      erp              !: evaporation damping (kg/m2/s = mm/s) 
    51 #if ! defined key_dynspg_rl 
    52    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    53       dmp              !: internal dampind term 
    54 #endif 
    5554 
    5655#  include "domzgr_substitute.h90" 
    … …  
    8079      !!        Louvain la Neuve Sea Ice Model in coupled mode 
    8180      !! 
    82       !! History : 
    83       !!   1.0  !  00-10  (O. Marti)  Original code 
    84       !!   2.0  !  02-12  (G. Madec)  F90: Free form and module 
    85       !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    8681      !!---------------------------------------------------------------------- 
    8782      !! * Arguments 
    … …  
    105100         emps  (:,:) = 0.e0 
    106101         erp   (:,:) = 0.e0 
    107 #if ! defined key_dynspg_rl  
    108          dmp   (:,:) = 0.e0 
    109 #endif 
    110102      ENDIF 
    111103 
    … …  
    143135 
    144136         ! total volume flux (use on sea-surface height) 
    145          emp (:,:) = fmass(:,:)  -  dmp(:,:) + runoff(:,:) + erp(:,:) 
     137         emp (:,:) = fmass(:,:)  + runoff(:,:) + erp(:,:) 
    146138#else 
    147139         ! Rigid-lid (emp=emps=E-P-R+Erp)  
    … …  
    216208         emps   (:,:) = 0.e0 
    217209         erp    (:,:) = 0.e0 
    218 #if ! defined key_dynspg_rl  
    219          dmp    (:,:) = 0.e0 
    220 #endif 
    221210      ENDIF 
    222211#if defined key_flx_core 
    … …  
    243232 
    244233         ! total volume flux (use on sea-surface height) 
    245          emp (:,:) = fmass(:,:) -   dmp(:,:) + runoff(:,:) + erp(:,:) + empold       
     234         emp (:,:) = fmass(:,:)             + runoff(:,:) + erp(:,:) + empold       
    246235#else 
    247236         ! Rigid-lid (emp=emps=E-P-R+Erp) 
    … …  
    446435         emps   (:,:) = 0.e0 
    447436         erp    (:,:) = 0.e0 
    448 #if ! defined key_dynspg_rl  
    449          dmp    (:,:) = 0.e0 
    450 #endif 
    451437      ENDIF 
    452438 
    … …  
    537523 
    538524         ! Contribution to sea level: 
    539          ! net upward water flux emp() = e-p + runoff() + erp() + dmp + empold 
     525         ! net upward water flux emp() = e-p + runoff() + erp() + empold 
    540526         emp (:,:) = zemp(:,:)     &   ! e-p data 
    541527            &      + runoff(:,:)   &   ! runoff data 
    542528            &      + erp(:,:)      &   ! restoring term to SSS data 
    543             &      + dmp(:,:)      &   ! freshwater flux associated with internal damping 
    544529            &      + empold            ! domain averaged annual mean correction 
    545530 
    … …  
    809794      REAL(wp) ::   zerpplus(jpi,jpj), zerpminus(jpi,jpj) 
    810795      REAL(wp) ::   zplus, zminus, zadefi 
    811 # if defined key_tradmp 
    812       INTEGER jk 
    813       REAL(wp), DIMENSION(jpi,jpj) ::   zstrdmp 
    814 # endif 
    815796#endif 
    816797      !!---------------------------------------------------------------------- 
    … …  
    838819      ! Free-surface 
    839820          
    840       ! Internal damping 
    841 # if defined key_tradmp 
    842       ! Vertical mean of dampind trend (computed in tradmp module) 
    843       zstrdmp(:,:) = 0.e0 
    844       DO jk = 1, jpk 
    845          zstrdmp(:,:) = zstrdmp(:,:) + strdmp(:,:,jk) * fse3t(:,:,jk) 
    846       END DO 
    847       ! volume flux associated to internal damping to climatology 
    848       dmp(:,:) = zstrdmp(:,:) * rauw / ( zsss(:,:) + 1.e-20 ) 
    849 # else 
    850       dmp(:,:) = 0.e0            ! No internal damping 
    851 # endif 
    852        
    853821      !   evaporation damping term ( Surface restoring ) 
    854822      zerpplus (:,:) = 0.e0 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/trabbl.F90

    r786 r790  
    152152      ! ----------------------------------------------------------------- 
    153153      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 
    154 #  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    155       jj = 1 
    156       DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     154#  if defined key_vectopt_loop 
     155      DO jj = 1, 1         ! vector opt. 
     156         DO ji = 1, jpij   ! forced the loop collapse 
    157157#  else 
    158158      DO jj = 1, jpj 
    … …  
    165165            zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1) 
    166166            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level 
    167 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    168          END DO 
    169 #  endif 
     167         END DO 
    170168      END DO 
    171169 
    172170      IF( ln_zps ) THEN      ! partial steps correction  
    173 # if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    174          jj = 1 
    175          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     171# if defined key_vectopt_loop 
     172      DO jj = 1, 1             ! vector opt. 
     173         DO ji = 1, jpij-jpi   ! forced the loop collapse 
    176174# else 
    177175         DO jj = 1, jpjm1 
    … …  
    186184               zahu(ji,jj) = atrbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 
    187185               zahv(ji,jj) = atrbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 
    188 # if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    189186            END DO 
    190 # endif 
    191187         END DO 
    192188      ELSE                    ! z-coordinate - full steps or s-coordinate 
    193189#   if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    194          jj = 1 
    195          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     190      DO jj = 1, 1             ! vector opt. 
     191         DO ji = 1, jpij-jpi   ! forced the loop collapse 
    196192#   else 
    197193         DO jj = 1, jpjm1 
    … …  
    202198               zahu(ji,jj) = atrbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 
    203199               zahv(ji,jj) = atrbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 
    204 #   if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    205200            END DO 
    206 #   endif 
    207201         END DO 
    208202      ENDIF 
    … …  
    218212 
    219213#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    220       jj = 1 
    221       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     214      DO jj = 1, 1             ! vector opt. 
     215         DO ji = 1, jpij-jpi   ! forced the loop collapse 
    222216#  else 
    223217      DO jj = 1, jpjm1 
    … …  
    236230            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    237231            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    238 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    239          END DO 
    240 #  endif 
    241       END DO 
    242  
    243 #  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    244       jj = 1 
    245       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     232         END DO 
     233      END DO 
     234 
     235#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     236      DO jj = 1, 1             ! vector opt. 
     237         DO ji = 1, jpij-jpi   ! forced the loop collapse 
    246238#  else 
    247239      DO jj = 1, jpjm1 
    … …  
    260252            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    261253            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    262 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    263          END DO 
    264 #  endif 
     254         END DO 
    265255      END DO 
    266256 
    … …  
    268258                               !  
    269259#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    270       jj = 1 
    271       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     260      DO jj = 1, 1             ! vector opt. 
     261         DO ji = 1, jpij-jpi   ! forced the loop collapse 
    272262#  else 
    273263      DO jj = 1, jpjm1 
    … …  
    279269            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    280270            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    281 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    282          END DO 
    283 #  endif 
    284       END DO 
    285  
    286 #  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    287       jj = 1 
    288       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     271         END DO 
     272      END DO 
     273 
     274#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     275      DO jj = 1, 1             ! vector opt. 
     276         DO ji = 1, jpij-jpi   ! forced the loop collapse 
    289277#  else 
    290278      DO jj = 1, jpjm1 
    … …  
    296284            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    297285            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    298 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    299          END DO 
    300 #  endif 
     286         END DO 
    301287      END DO 
    302288 
    … …  
    304290 
    305291#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    306       jj = 1 
    307       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     292      DO jj = 1, 1             ! vector opt. 
     293         DO ji = 1, jpij-jpi   ! forced the loop collapse 
    308294#  else 
    309295      DO jj = 1, jpjm1 
    … …  
    312298            ! local density gradient along i-bathymetric slope 
    313299            zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
    314                      -  ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
     300               &     -  ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
    315301            ! sign of local i-gradient of density multiplied by the i-slope 
    316302            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    317303            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    318 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    319          END DO 
    320 #  endif 
    321       END DO 
    322  
    323 #  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    324       jj = 1 
    325       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     304         END DO 
     305      END DO 
     306 
     307#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     308      DO jj = 1, 1             ! vector opt. 
     309         DO ji = 1, jpij-jpi   ! forced the loop collapse 
    326310#  else 
    327311      DO jj = 1, jpjm1 
    … …  
    330314            ! local density gradient along j-bathymetric slope 
    331315            zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
    332                      -  ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )    
     316               &     -  ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )    
    333317            ! sign of local j-gradient of density multiplied by the j-slope 
    334             zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     318            zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    335319            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    336 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    337          END DO 
    338 #  endif 
     320         END DO 
    339321      END DO 
    340322       
    … …  
    351333      ! first derivative (gradient) 
    352334#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    353       jj = 1 
    354       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     335      DO jj = 1, 1             ! vector opt. 
     336         DO ji = 1, jpij-jpi   ! forced the loop collapse 
    355337#  else 
    356338      DO jj = 1, jpjm1 
    … …  
    362344            zky(ji,jj) = zkj(ji,jj) * ( ztbb(ji,jj+1) - ztbb(ji,jj) ) 
    363345            zkw(ji,jj) = zkj(ji,jj) * ( zsbb(ji,jj+1) - zsbb(ji,jj) ) 
    364 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    365          END DO 
    366 #  endif 
     346         END DO 
    367347      END DO 
    368348 
    … …  
    401381      ! second derivative (divergence) and add to the general tracer trend 
    402382#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    403       jj = 1 
    404       DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     383      DO jj = 1, 1                   ! vector opt. 
     384         DO ji = jpi+2, jpij-jpi-1   ! forced the loop collapse 
    405385#  else 
    406386      DO jj = 2, jpjm1 
    … …  
    415395            ta(ji,jj,ik) = ta(ji,jj,ik) + zta 
    416396            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 
    417 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    418          END DO 
    419 #  endif 
     397         END DO 
    420398      END DO 
    421399 
    … …  
    441419   !!   Default option :                 NO advective bottom boundary layer 
    442420   !!---------------------------------------------------------------------- 
    443    SUBROUTINE tra_bbl_adv (kt )              ! Empty routine 
    444       INTEGER, INTENT(in) :: kt 
     421   SUBROUTINE tra_bbl_adv( kt )              ! Empty routine 
     422      INTEGER :: kt 
    445423      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt 
    446424   END SUBROUTINE tra_bbl_adv 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/trabbl_adv.h90

    r719 r790  
    9999      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 
    100100 
    101 #if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    102       jj = 1 
    103       DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     101#if defined key_vectopt_loop  
     102      DO jj = 1, 1 
     103         DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    104104#else 
    105105      DO jj = 1, jpj 
    … …  
    115115            zunb(ji,jj) = un(ji,jj,mbku(ji,jj))  
    116116            zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj))  
    117 #if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    118          END DO 
    119 #endif 
     117         END DO 
    120118      END DO 
    121119 
    … …  
    224222 
    225223      ! ... is equal to zero but where bbl will work. 
    226       u_bbl(:,:,:) = 0.e0 
    227       v_bbl(:,:,:) = 0.e0 
     224      u_bbl(:,:,:) = 0.e0   ;   v_bbl(:,:,:) = 0.e0 
    228225 
    229226      IF( ln_zps ) THEN     ! partial steps correction    
    230227       
    231 # if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    232          jj = 1 
    233          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     228# if defined key_vectopt_loop 
     229         DO jj = 1, 1 
     230            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    234231# else    
    235232         DO jj = 1, jpjm1 
    … …  
    249246                  v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv)        
    250247               ENDIF 
    251 # if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    252             END DO 
    253 # endif 
     248            END DO 
    254249         END DO 
    255250 
    … …  
    259254      ELSE       ! if not partial step loop over the whole domain no lbc call 
    260255 
    261 #if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    262          jj = 1 
    263          DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     256#if defined key_vectopt_loop 
     257         DO jj = 1, 1 
     258            DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    264259#else 
    265260         DO jj = 1, jpj 
    … …  
    272267                  v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv)        
    273268               ENDIF 
    274 #if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    275             END DO 
    276 #endif 
     269            END DO 
    277270         END DO 
    278271        
    … …  
    284277      ! ... Second order centered tracer flux at u and v-points 
    285278 
    286 # if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    287       jj = 1 
    288       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     279# if defined key_vectopt_loop 
     280      DO jj = 1, 1 
     281         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    289282# else 
    290283      DO jj = 1, jpjm1 
    … …  
    309302            zwz(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * zsbb(ji  ,jj  )   & 
    310303               &          +( zfvj - ABS( zfvj ) ) * zsbb(ji  ,jj+1) ) * 0.5 
    311 #if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    312          END DO 
    313 #endif 
    314         END DO 
    315 # if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    316       jj = 1 
    317       DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     304         END DO 
     305      END DO 
     306# if defined key_vectopt_loop 
     307      DO jj = 1, 1 
     308         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    318309# else 
    319310      DO jj = 2, jpjm1 
    … …  
    331322            ta(ji,jj,ik) = ta(ji,jj,ik) + zta 
    332323            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 
    333 #if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    334          END DO 
    335 #endif 
     324         END DO 
    336325      END DO 
    337326 
    … …  
    365354      IF( ln_zps ) THEN 
    366355      
    367 # if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    368          jj = 1 
    369          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     356# if defined key_vectopt_loop  
     357         DO jj = 1, 1 
     358            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    370359# else 
    371360         DO jj = 1, jpjm1 
    … …  
    383372               zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u   
    384373               zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v 
    385 #if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    386             END DO 
    387 #endif 
     374            END DO 
    388375         END DO   
    389376    
    390377      ELSE 
    391378 
    392 # if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    393          jj = 1 
    394          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     379# if defined key_vectopt_loop 
     380         DO jj = 1, 1 
     381            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    395382# else 
    396383         DO jj = 1, jpjm1 
    … …  
    401388               zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku)  
    402389               zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv)  
    403 #if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    404             END DO 
    405 #endif 
     390            END DO 
    406391         END DO 
    407392 
    … …  
    409394  
    410395 
    411 # if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    412       jj = 1 
    413       DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     396# if defined key_vectopt_loop 
     397      DO jj = 1, 1 
     398         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    414399# else 
    415400      DO jj = 2, jpjm1 
    … …  
    425410               &   ) / zbt 
    426411 
    427 # if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    428          END DO 
    429 # endif 
    430         END DO 
     412         END DO 
     413      END DO 
    431414 
    432415      ! 7. compute additional vertical velocity to be used in t boxes 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRD/trdicp.F90

    r719 r790  
    3636 
    3737   INTERFACE trd_icp 
    38       MODULE PROCEDURE trd_2d, trd_3d 
     38      MODULE PROCEDURE trd_2d, trd_3d, trd_u2d, trd_u3d 
    3939   END INTERFACE 
    4040 
    … …  
    4444   PUBLIC   trd_icp_init  ! called by opa.F90 
    4545 
     46   !! Variables used for diagnostics 
     47   REAL(wp) ::   tvolt        !: volume of the whole ocean computed at t-points 
     48   REAL(wp) ::   tvolu        !: volume of the whole ocean computed at u-points 
     49   REAL(wp) ::   tvolv        !: volume of the whole ocean computed at v-points 
     50 
     51   !! Active Tracer trend diagnostics variables 
     52   REAL(wp), DIMENSION(jpt_trd,2) ::   tsmo         !: tracers trends average  
     53   REAL(wp), DIMENSION(jpt_trd,2) ::   ts2          !: tracers square trends average  
     54 
     55   !! Momentum trends diagnostics variables 
     56   REAL(wp), DIMENSION(jptot_dyn) ::   umo, vmo         !: momentum trends average  
     57   REAL(wp), DIMENSION(jptot_dyn) ::   hke              !: momentum square trends average  
     58   REAL(wp) ::   rpktrd   !: potential to kinetic energy conversion 
     59   REAL(wp) ::   peke     !: conversion potential energy - kinetic energy trend 
     60 
    4661   !! * Substitutions 
    4762#  include "domzgr_substitute.h90" 
    … …  
    5570CONTAINS 
    5671 
    57    SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype, clpas ) 
     72   SUBROUTINE trd_2d( ptrd, ktra, ktrd , ctype, clpas ) 
    5873      !!--------------------------------------------------------------------- 
    5974      !!                  ***  ROUTINE trd_2d  *** 
    … …  
    6277      !!              momentum equations at every time step frequency ntrd. 
    6378      !!---------------------------------------------------------------------- 
    64       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dx             ! Temperature or U trend  
    65       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dy             ! Salinity    or V trend 
    66       INTEGER                     , INTENT(in   ) ::   ktrd                ! tracer trend index 
    67       CHARACTER(len=3)            , INTENT(in   ) ::   ctype               ! momentum ('DYN') or tracers ('TRA') trends 
     79      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   ptrd      ! tracer or u trend 
     80      INTEGER                     , INTENT(in   )           ::   ktra      ! tracer index 
     81      INTEGER                     , INTENT(in   )           ::   ktrd      ! tracer trend index 
     82      CHARACTER(len=3)            , INTENT(in   )           ::   ctype     ! tracer type (='TRA' or 'TRC') 
    6883      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   clpas     ! number of passage 
    6984      !! 
    70       INTEGER  ::   ji, jj                                                 ! loop indices 
    71       CHARACTER(len=3) ::   cpas                                           ! number of passage 
    72       REAL(wp) ::   zmsku, zbtu, zbt                                       ! temporary scalars 
    73       REAL(wp) ::   zmskv, zbtv                                            !    "         " 
    74       !!---------------------------------------------------------------------- 
    75  
    76       ! Control of optional arguments 
    77       cpas = 'fst' 
     85      CHARACTER(len=3) ::   cpas   ! number of passage 
     86      REAL(wp)         ::   zsum   ! temporary scalars 
     87      !!---------------------------------------------------------------------- 
     88 
     89      cpas = 'fst'                             ! Control of optional arguments 
    7890      IF( PRESENT(clpas) )  cpas = clpas 
     91 
     92      ! 1. Mask volumic trends 
     93      ptrd(:,:) = e1t(:,:) * e2t(:,:) * fse3t(:,:,1) * ptrd(:,:) * tmask_i(:,:) 
     94       
     95      ! 2. Basin averaged tracer trends 
     96      SELECT CASE( ctype ) 
     97      CASE( 'TRA' )              ! Tracers 
     98         zsum = SUM( ptrd(:,:) ) 
     99         IF( cpas == 'fst' ) THEN   ;   tsmo(ktrd,ktra) =                   zsum 
     100         ELSE                       ;   tsmo(ktrd,ktra) = tsmo(ktrd,ktra) + zsum 
     101         ENDIF 
     102      CASE( 'TRC' )              ! Passive tracers 
     103         !      ....  to be done 
     104      END SELECT 
     105       
     106      ! 3. Basin averaged tracer square trends (i.e. trd * now tracer field) 
     107      SELECT CASE( ctype ) 
     108      CASE( 'TRA' )              ! Tracers 
     109         IF( ktra == jp_tem )   zsum = SUM(  ptrd(:,:) * tn(:,:,1) ) 
     110         IF( ktra == jp_sal )   zsum = SUM(  ptrd(:,:) * sn(:,:,1) ) 
     111         IF( cpas == 'fst' ) THEN   ;   ts2(ktrd,ktra) =                  zsum 
     112         ELSE                       ;   ts2(ktrd,ktra) = ts2(ktrd,ktra) + zsum 
     113         ENDIF 
     114      CASE( 'TRC' )              ! Passive tracers 
     115         !      ....  to be done 
     116      END SELECT 
     117      ! 
     118   END SUBROUTINE trd_2d 
     119 
     120 
     121   SUBROUTINE trd_3d( ptrd, ktra, ktrd , ctype, clpas ) 
     122      !!--------------------------------------------------------------------- 
     123      !!                  ***  ROUTINE trd_3d  *** 
     124      !!  
     125      !! ** Purpose : verify the basin averaged properties of tracers and/or 
     126      !!              momentum equations at every time step frequency ntrd. 
     127      !!---------------------------------------------------------------------- 
     128      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   ptrd      ! tracer or u trend 
     129      INTEGER                         , INTENT(in   )           ::   ktra      ! tracer index 
     130      INTEGER                         , INTENT(in   )           ::   ktrd      ! tracer trend index 
     131      CHARACTER(len=3)                , INTENT(in   )           ::   ctype     ! tracer type (='TRA' or 'TRC') 
     132      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   clpas     ! number of passage 
     133      !! 
     134      INTEGER          ::   jk     ! dummy loop indices 
     135      CHARACTER(len=3) ::   cpas   ! number of passage 
     136      REAL(wp)         ::   zsum   ! temporary scalars 
     137      REAL(wp), DIMENSION(jpi,jpj) ::   zsurf          ! 2D workspace array 
     138      !!---------------------------------------------------------------------- 
     139 
     140      cpas = 'fst'                             ! Control of optional arguments 
     141      IF( PRESENT(clpas) )  cpas = clpas 
     142 
     143      ! 1. Mask volumic trends 
     144      zsurf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 
     145      DO jk = 1, jpk 
     146         ptrd(:,:,jk) = zsurf(:,:) * fse3t(:,:,jk) * ptrd(:,:,jk) * tmask(:,:,jk) 
     147      END DO 
     148 
     149      ! 2. Basin averaged tracer trends 
     150      SELECT CASE( ctype ) 
     151      CASE( 'TRA' )              ! Tracers 
     152         zsum = SUM( ptrd(:,:,:) ) 
     153         IF( cpas == 'fst' ) THEN   ;   tsmo(ktrd,ktra) =                   zsum 
     154         ELSE                       ;   tsmo(ktrd,ktra) = tsmo(ktrd,ktra) + zsum 
     155         ENDIF 
     156      CASE( 'TRC' )              ! Passive tracers 
     157         !      ....  to be done 
     158      END SELECT 
     159 
     160      ! 3. Basin averaged tracer square trends (i.e. trd * now tracer field) 
     161      SELECT CASE( ctype ) 
     162      CASE( 'TRA' )              ! Tracers 
     163         IF( ktra == jp_tem )   zsum = SUM(  ptrd(:,:,:) * tn(:,:,:) ) 
     164         IF( ktra == jp_sal )   zsum = SUM(  ptrd(:,:,:) * sn(:,:,:) ) 
     165         IF( cpas == 'fst' ) THEN   ;   ts2(ktrd,ktra) =                  zsum 
     166         ELSE                       ;   ts2(ktrd,ktra) = ts2(ktrd,ktra) + zsum 
     167         ENDIF 
     168      CASE( 'TRC' )              ! Passive tracers 
     169         !      ....  to be done 
     170      END SELECT 
     171      ! 
     172   END SUBROUTINE trd_3d 
     173 
     174 
     175   SUBROUTINE trd_u2d( ptrdu, ptrdv, ktrd , ctype, clpas ) 
     176      !!--------------------------------------------------------------------- 
     177      !!                  ***  ROUTINE trd_2d  *** 
     178      !!  
     179      !! ** Purpose : verify the basin averaged properties of tracers and/or 
     180      !!              momentum equations at every time step frequency ntrd. 
     181      !!---------------------------------------------------------------------- 
     182      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   ptrdu, ptrdv   ! U and V momentum trends  
     183      INTEGER                     , INTENT(in   )           ::   ktrd           ! tracer trend index 
     184      CHARACTER(len=3)            , INTENT(in   )           ::   ctype          ! momentum ('DYN') 
     185      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   clpas          ! number of passage 
     186      !! 
     187      INTEGER          ::   ji, jj        ! loop indices 
     188      CHARACTER(len=3) ::   cpas          ! number of passage 
     189      REAL(wp)         ::   zmsku, zbtu   ! temporary scalars 
     190      REAL(wp)         ::   zmskv, zbtv   !    "         " 
     191      !!---------------------------------------------------------------------- 
     192 
     193      cpas = 'fst'                           ! Control of optional arguments 
     194      IF( PRESENT(clpas) )  cpas = clpas 
     195 
     196      SELECT CASE( ctype ) 
     197      ! 
     198      CASE( 'DYN' )              ! Momentum 
    79199 
    80200      ! 1. Mask trends 
    81201      ! -------------- 
    82  
    83       SELECT CASE( ctype ) 
    84       ! 
    85       CASE( 'DYN' )              ! Momentum 
    86          DO jj = 1, jpjm1 
    87             DO ji = 1, jpim1 
    88                zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,1) 
    89                zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 
    90                ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * zmsku 
    91                ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * zmskv 
    92             END DO 
    93          END DO 
    94          ptrd2dx(jpi, : ) = 0.e0      ;      ptrd2dy(jpi, : ) = 0.e0 
    95          ptrd2dx( : ,jpj) = 0.e0      ;      ptrd2dy( : ,jpj) = 0.e0 
    96          ! 
    97       CASE( 'TRA' )              ! Tracers 
    98          ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:) 
    99          ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:) 
    100          ! 
    101       END SELECT 
     202      DO jj = 1, jpjm1 
     203         DO ji = 1, jpim1 
     204            zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,1) 
     205            zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 
     206            ptrdu(ji,jj) = ptrdu(ji,jj) * zmsku 
     207            ptrdv(ji,jj) = ptrdv(ji,jj) * zmskv 
     208         END DO 
     209      END DO 
     210      ptrdu(jpi, : ) = 0.e0      ;      ptrdv(jpi, : ) = 0.e0 
     211      ptrdu( : ,jpj) = 0.e0      ;      ptrdv( : ,jpj) = 0.e0 
    102212       
    103213      ! 2. Basin averaged tracer/momentum trends 
    104214      ! ---------------------------------------- 
    105  
    106       SELECT CASE( ctype ) 
    107       ! 
    108       CASE( 'DYN' )              ! Momentum 
    109          umo(ktrd) = 0.e0 
    110          vmo(ktrd) = 0.e0 
    111          ! 
    112          SELECT CASE( ktrd ) 
    113          ! 
    114          CASE( jpdyn_trd_swf )         ! surface forcing 
    115             DO jj = 1, jpj 
    116                DO ji = 1, jpi 
    117                   umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 
    118                   vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 
    119                END DO 
    120             END DO 
     215      umo(ktrd) = 0.e0 
     216      vmo(ktrd) = 0.e0 
     217      ! 
     218      SELECT CASE( ktrd ) 
     219      ! 
     220      CASE( jpdyn_trd_swf )         ! surface forcing 
     221         DO jj = 1, jpj 
     222            DO ji = 1, jpi 
     223               umo(ktrd) = umo(ktrd) + ptrdu(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 
     224               vmo(ktrd) = vmo(ktrd) + ptrdv(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 
     225            END DO 
     226         END DO 
    121227            ! 
    122228         CASE( jpdyn_trd_bfr )         ! bottom friction fluxes 
    123229            DO jj = 1, jpj 
    124230               DO ji = 1, jpi 
    125                   umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj) 
    126                   vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj) 
     231                  umo(ktrd) = umo(ktrd) + ptrdu(ji,jj) 
     232                  vmo(ktrd) = vmo(ktrd) + ptrdv(ji,jj) 
    127233               END DO 
    128234            END DO 
    129235            ! 
    130          END SELECT 
    131          ! 
    132       CASE( 'TRA' )              ! Tracers 
    133          IF( cpas == 'fst' )   THEN 
    134             tmo(ktrd) = 0.e0 
    135             smo(ktrd) = 0.e0 
    136          ENDIF 
    137          DO jj = 1, jpj 
    138             DO ji = 1, jpi 
    139                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) 
    140                tmo(ktrd) =  tmo(ktrd) + ptrd2dx(ji,jj) * zbt 
    141                smo(ktrd) =  smo(ktrd) + ptrd2dy(ji,jj) * zbt 
    142             END DO 
    143          END DO 
    144          ! 
    145236      END SELECT 
    146        
     237      !    
    147238      ! 3. Basin averaged tracer/momentum square trends 
    148239      ! ---------------------------------------------- 
    149240      ! c a u t i o n: field now 
    150241       
    151       SELECT CASE( ctype ) 
    152       ! 
    153       CASE( 'DYN' )              ! Momentum 
    154242         hke(ktrd) = 0.e0 
    155243         DO jj = 1, jpj 
    … …  
    157245               zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 
    158246               zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 
    159                hke(ktrd) = hke(ktrd)   & 
    160                &   + un(ji,jj,1) * ptrd2dx(ji,jj) * zbtu & 
    161                &   + vn(ji,jj,1) * ptrd2dy(ji,jj) * zbtv 
     247               hke(ktrd) = hke(ktrd) + un(ji,jj,1) * ptrdu(ji,jj) * zbtu   & 
     248               &                     + vn(ji,jj,1) * ptrdv(ji,jj) * zbtv 
    162249            END DO 
    163250         END DO 
    164251         ! 
    165       CASE( 'TRA' )              ! Tracers 
    166          IF( cpas == 'fst' )   THEN 
    167             t2(ktrd) = 0.e0 
    168             s2(ktrd) = 0.e0 
    169          ENDIF 
    170          DO jj = 1, jpj 
    171             DO ji = 1, jpi 
    172                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) 
    173                t2(ktrd) = t2(ktrd) + ptrd2dx(ji,jj) * zbt * tn(ji,jj,1) 
    174                s2(ktrd) = s2(ktrd) + ptrd2dy(ji,jj) * zbt * sn(ji,jj,1) 
    175             END DO 
    176          END DO 
    177          !       
    178252      END SELECT 
    179253      ! 
    180    END SUBROUTINE trd_2d 
    181  
    182  
    183    SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd, ctype, clpas ) 
     254   END SUBROUTINE trd_u2d 
     255 
     256 
     257   SUBROUTINE trd_u3d( ptrdu, ptrdv, ktrd, ctype, clpas ) 
    184258      !!--------------------------------------------------------------------- 
    185259      !!                  ***  ROUTINE trd_3d  *** 
    … …  
    188262      !!              momentum equations at every time step frequency ntrd. 
    189263      !!---------------------------------------------------------------------- 
    190       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx            ! Temperature or U trend  
    191       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy            ! Salinity    or V trend 
    192       INTEGER,                          INTENT(in   ) ::   ktrd               ! momentum or tracer trend index 
    193       CHARACTER(len=3),                 INTENT(in   ) ::   ctype              ! momentum ('DYN') or tracers ('TRA') trends 
    194       CHARACTER(len=3),                 INTENT(in   ), OPTIONAL ::   clpas    ! number of passage 
     264      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   ptrdu, ptrdv   ! U and V momentum trends 
     265      INTEGER,                          INTENT(in   )           ::   ktrd           ! momentum trend index 
     266      CHARACTER(len=3),                 INTENT(in   )           ::   ctype          ! momentum (='DYN') 
     267      CHARACTER(len=3),                 INTENT(in   ), OPTIONAL ::   clpas          ! number of passage 
    195268      !! 
    196269      INTEGER ::   ji, jj, jk 
    197       CHARACTER(len=3) ::   cpas                                              ! number of passage 
    198       REAL(wp) ::   zbt, zbtu, zbtv, zmsku, zmskv                             ! temporary scalars 
    199       !!---------------------------------------------------------------------- 
    200  
    201       ! Control of optional arguments 
    202       cpas = 'fst' 
     270      CHARACTER(len=3) ::   cpas               ! number of passage 
     271      REAL(wp) ::   zbtu, zbtv, zmsku, zmskv   ! temporary scalars 
     272      !!---------------------------------------------------------------------- 
     273 
     274      cpas = 'fst'                            ! Control of optional arguments 
    203275      IF( PRESENT(clpas) )  cpas = clpas 
    204276 
    205       ! 1. Mask the trends 
    206       ! ------------------ 
    207  
    208277      SELECT CASE( ctype ) 
    209278      ! 
    210279      CASE( 'DYN' )              ! Momentum         
     280 
     281         ! 1. Mask the trends 
     282         ! ------------------ 
    211283         DO jk = 1, jpk 
    212284            DO jj = 1, jpjm1 
    … …  
    214286                  zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    215287                  zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    216                   ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * zmsku 
    217                   ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * zmskv 
     288                  ptrdu(ji,jj,jk) = ptrdu(ji,jj,jk) * zmsku 
     289                  ptrdv(ji,jj,jk) = ptrdv(ji,jj,jk) * zmskv 
    218290               END DO 
    219291            END DO 
    220292         END DO 
    221          ptrd3dx(jpi, : ,:) = 0.e0      ;      ptrd3dy(jpi, : ,:) = 0.e0 
    222          ptrd3dx( : ,jpj,:) = 0.e0      ;      ptrd3dy( : ,jpj,:) = 0.e0 
     293         ptrdu(jpi, : ,:) = 0.e0      ;      ptrdv(jpi, : ,:) = 0.e0 
     294         ptrdu( : ,jpj,:) = 0.e0      ;      ptrdv( : ,jpj,:) = 0.e0 
    223295         ! 
    224       CASE( 'TRA' )              ! Tracers 
    225          DO jk = 1, jpk 
    226             ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    227             ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    228          END DO 
    229          ! 
    230       END SELECT    
    231296 
    232297      ! 2. Basin averaged tracer/momentum trends 
    233298      ! ---------------------------------------- 
    234299       
    235       SELECT CASE( ctype ) 
    236       ! 
    237       CASE( 'DYN' )              ! Momentum 
    238300         umo(ktrd) = 0.e0 
    239301         vmo(ktrd) = 0.e0 
    … …  
    243305                  zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    244306                  zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    245                   umo(ktrd) = umo(ktrd) + ptrd3dx(ji,jj,jk) * zbtu 
    246                   vmo(ktrd) = vmo(ktrd) + ptrd3dy(ji,jj,jk) * zbtv 
     307                  umo(ktrd) = umo(ktrd) + ptrdu(ji,jj,jk) * zbtu 
     308                  vmo(ktrd) = vmo(ktrd) + ptrdv(ji,jj,jk) * zbtv 
    247309               END DO 
    248310            END DO 
    249311         END DO 
    250312         ! 
    251       CASE( 'TRA' )              ! Tracers 
    252          IF( cpas == 'fst' )   THEN 
    253             tmo(ktrd) = 0.e0 
    254             smo(ktrd) = 0.e0 
    255          ENDIF 
    256          DO jk = 1, jpkm1 
    257             DO jj = 1, jpj 
    258                DO ji = 1, jpi 
    259                   zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)  
    260                   tmo(ktrd) =  tmo(ktrd) + ptrd3dx(ji,jj,jk) * zbt 
    261                   smo(ktrd) =  smo(ktrd) + ptrd3dy(ji,jj,jk) * zbt 
    262                END DO 
    263             END DO 
    264          END DO 
    265          ! 
    266       END SELECT 
    267313 
    268314      ! 3. Basin averaged tracer/momentum square trends 
    … …  
    270316      ! c a u t i o n: field now 
    271317       
    272       SELECT CASE( ctype ) 
    273       ! 
    274       CASE( 'DYN' )              ! Momentum 
    275318         hke(ktrd) = 0.e0 
    276319         DO jk = 1, jpk 
    … …  
    279322                  zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    280323                  zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    281                   hke(ktrd) = hke(ktrd)   & 
    282                   &   + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * zbtu & 
    283                   &   + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * zbtv 
    284                END DO 
    285             END DO 
    286          END DO 
    287          ! 
    288       CASE( 'TRA' )              ! Tracers 
    289          IF( cpas == 'fst' )   THEN 
    290             t2(ktrd) = 0.e0 
    291             s2(ktrd) = 0.e0 
    292          ENDIF 
    293          DO jk = 1, jpk 
    294             DO jj = 1, jpj 
    295                DO ji = 1, jpi 
    296                   zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    297                   t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * zbt * tn(ji,jj,jk) 
    298                   s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * zbt * sn(ji,jj,jk) 
     324                  hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * ptrdu(ji,jj,jk) * zbtu   & 
     325                  &                     + vn(ji,jj,jk) * ptrdv(ji,jj,jk) * zbtv 
    299326               END DO 
    300327            END DO 
    … …  
    303330      END SELECT 
    304331      ! 
    305    END SUBROUTINE trd_3d 
    306  
     332   END SUBROUTINE trd_u3d 
    307333 
    308334 
    … …  
    313339      !! ** Purpose :   Read the namtrd namelist 
    314340      !!---------------------------------------------------------------------- 
    315       INTEGER  ::   ji, jj, jk 
    316       REAL(wp) ::   zmskt 
     341      INTEGER  ::   jk 
    317342#if  defined key_trddyn 
     343      INTEGER  ::   ji, jj 
    318344      REAL(wp) ::   zmsku, zmskv 
    319345#endif 
     346      REAL(wp), DIMENSION(jpi,jpj) ::   zsurf          ! 2D workspace array 
    320347      !!---------------------------------------------------------------------- 
    321348 
    … …  
    328355      ! Total volume at t-points: 
    329356      tvolt = 0.e0 
     357      zsurf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 
    330358      DO jk = 1, jpkm1 
    331          DO jj = 2, jpjm1 
    332             DO ji = fs_2, fs_jpim1   ! vector opt. 
    333                zmskt = tmask(ji,jj,jk) * tmask_i(ji,jj) 
    334                tvolt = tvolt + zmskt * e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) 
    335             END DO 
    336          END DO 
     359            tvolt = tvolt + SUM( tmask(:,:,jk) * zsurf(:,:) * fse3t(:,:,jk) ) 
    337360      END DO 
    338361      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain 
    … …  
    379402      !! 
    380403      INTEGER  ::   ji, jj, jk 
    381       REAL(wp) ::   ze1e2w, zcof, zbe1ru, zbe2rv, zbtr, ztz, zth   !    "      scalars 
     404      REAL(wp) ::   zcof, zbe1ru, zbe2rv, zbtr, ztz, zth   !    "      scalars 
     405      REAL(wp), DIMENSION(jpi,jpj)     ::   zsurf          ! 2D workspace array 
    382406      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zkepe, zkx, zky, zkz   ! temporary arrays 
    383407      !!---------------------------------------------------------------------- 
    … …  
    400424 
    401425         ! Density flux at w-point 
     426         zsurf(:,:) = 0.5 * e1t(:,:) * e2t(:,:) * tmask_i(:,:) /rau0 
     427!!gm better use bn2.... 
     428         zkz(:,:,1) = 0.e0 
    402429         DO jk = 2, jpk 
    403             DO jj = 1, jpj 
    404                DO ji = 1, jpi 
    405                   ze1e2w = 0.5 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) * tmask_i(ji,jj) 
    406                   zkz(ji,jj,jk) = ze1e2w / rau0 * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) ) 
    407                END DO 
    408             END DO 
    409          END DO 
    410          zkz(:,:,1) = 0.e0 
     430            zkz(:,:,jk) = zsurf(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) 
     431         END DO 
    411432          
    412433         ! Density flux at u and v-points 
    … …  
    588609         ! ------------------------------- 
    589610         IF( lk_mpp ) THEN 
    590             CALL mpp_sum( tmo, jptot_tra )    
    591             CALL mpp_sum( smo, jptot_tra ) 
    592             CALL mpp_sum( t2 , jptot_tra ) 
    593             CALL mpp_sum( s2 , jptot_tra ) 
     611            CALL mpp_sum( tsmo, jpt_trd )    
     612            CALL mpp_sum( ts2 , jpt_trd ) 
    594613         ENDIF 
    595614 
    … …  
    601620            WRITE (numout,*) 
    602621            WRITE (numout,9400) kt 
    603             WRITE (numout,9401) (tmo(jpicpt_xad)+tmo(jpicpt_yad))/ tvolt, (smo(jpicpt_xad)+smo(jpicpt_yad))/ tvolt 
    604             WRITE (numout,9402)  tmo(jpicpt_zad) / tvolt, smo(jpicpt_zad) / tvolt 
    605             WRITE (numout,9403)  tmo(jpicpt_ldf) / tvolt, smo(jpicpt_ldf) / tvolt 
    606             WRITE (numout,9404)  tmo(jpicpt_zdf) / tvolt, smo(jpicpt_zdf) / tvolt 
    607             WRITE (numout,9405)  tmo(jpicpt_npc) / tvolt, smo(jpicpt_npc) / tvolt 
    608             WRITE (numout,9406)  tmo(jpicpt_dmp) / tvolt, smo(jpicpt_dmp) / tvolt 
    609             WRITE (numout,9407)  tmo(jpicpt_qsr) / tvolt 
    610             WRITE (numout,9408)  tmo(jpicpt_nsr) / tvolt, smo(jpicpt_nsr) / tvolt 
     622            WRITE (numout,9401) ( tsmo(jpt_trd_xad,jp_tem) + tsmo(jpt_trd_yad,jp_tem)  ) / tvolt,   & 
     623               &                ( tsmo(jpt_trd_xad,jp_sal) + tsmo(jpt_trd_yad,jp_sal)  ) / tvolt 
     624            WRITE (numout,9402)   tsmo(jpt_trd_zad,jp_tem) / tvolt,   tsmo(jpt_trd_zad,jp_sal) / tvolt 
     625            WRITE (numout,9403)   tsmo(jpt_trd_ldf,jp_tem) / tvolt,   tsmo(jpt_trd_ldf,jp_sal) / tvolt 
     626            WRITE (numout,9404)   tsmo(jpt_trd_zdf,jp_tem) / tvolt,   tsmo(jpt_trd_zdf,jp_sal) / tvolt 
     627            WRITE (numout,9405)   tsmo(jpt_trd_npc,jp_tem) / tvolt,   tsmo(jpt_trd_npc,jp_sal) / tvolt 
     628            WRITE (numout,9406)   tsmo(jpt_trd_dmp,jp_tem) / tvolt,   tsmo(jpt_trd_dmp,jp_sal) / tvolt 
     629            WRITE (numout,9407)   tsmo(jpt_trd_qsr,jp_tem) / tvolt 
     630            WRITE (numout,9408)   tsmo(jpt_trd_qns,jp_tem) / tvolt,   tsmo(jpt_trd_qns,jp_sal) / tvolt 
    611631            WRITE (numout,9409)  
    612             WRITE (numout,9410) (  tmo(jpicpt_xad) + tmo(jpicpt_yad) + tmo(jpicpt_zad) + tmo(jpicpt_ldf) + tmo(jpicpt_zdf)   & 
    613             &                    + tmo(jpicpt_npc) + tmo(jpicpt_dmp) + tmo(jpicpt_qsr) + tmo(jpicpt_nsr) ) / tvolt,   & 
    614             &                   (  smo(jpicpt_xad) + smo(jpicpt_yad) + smo(jpicpt_zad) + smo(jpicpt_ldf) + smo(jpicpt_zdf)   & 
    615             &                    + smo(jpicpt_npc) + smo(jpicpt_dmp)                   + smo(jpicpt_nsr) ) / tvolt 
    616          ENDIF 
    617  
    618 9400     FORMAT(' tracer trend at it= ',i6,' :     temperature',   & 
    619               '              salinity',/' ============================') 
     632            WRITE (numout,9410) (  tsmo(jpt_trd_xad,jp_tem) + tsmo(jpt_trd_yad,jp_tem) + tsmo(jpt_trd_zad,jp_tem)     & 
     633               &                 + tsmo(jpt_trd_ldf,jp_tem) + tsmo(jpt_trd_zdf,jp_tem) + tsmo(jpt_trd_npc,jp_tem)     & 
     634               &                 + tsmo(jpt_trd_dmp,jp_tem) + tsmo(jpt_trd_qsr,jp_tem) + tsmo(jpt_trd_qns,jp_tem) )   & 
     635               &                / tvolt,   & 
     636               &                (  tsmo(jpt_trd_xad,jp_sal) + tsmo(jpt_trd_yad,jp_sal) + tsmo(jpt_trd_zad,jp_sal)     & 
     637               &                 + tsmo(jpt_trd_ldf,jp_sal) + tsmo(jpt_trd_zdf,jp_sal) + tsmo(jpt_trd_npc,jp_sal)     & 
     638               &                 + tsmo(jpt_trd_dmp,jp_sal)                           + tsmo(jpt_trd_qns,jp_sal) )   & 
     639               &                / tvolt 
     640 
     641 
     6429400     FORMAT(' tracer trend at it= ',i6,' :     temperature              salinity', /,   & 
     643                ' ============================') 
    6206449401     FORMAT(' horizontal advection        ',e20.13,'     ',e20.13) 
    6216459402     FORMAT(' vertical advection          ',e20.13,'     ',e20.13) 
    … …  
    630654 
    631655 
    632          IF(lwp) THEN 
    633656            WRITE (numout,*) 
    634657            WRITE (numout,*) 
    635658            WRITE (numout,9420) kt 
    636             WRITE (numout,9421) ( t2(jpicpt_xad)+t2(jpicpt_yad) )/ tvolt, ( s2(jpicpt_xad)+s2(jpicpt_yad) )/ tvolt 
    637             WRITE (numout,9422)   t2(jpicpt_zad) / tvolt, s2(jpicpt_zad) / tvolt 
    638             WRITE (numout,9423)   t2(jpicpt_ldf) / tvolt, s2(jpicpt_ldf) / tvolt 
    639             WRITE (numout,9424)   t2(jpicpt_zdf) / tvolt, s2(jpicpt_zdf) / tvolt 
    640             WRITE (numout,9425)   t2(jpicpt_npc) / tvolt, s2(jpicpt_npc) / tvolt 
    641             WRITE (numout,9426)   t2(jpicpt_dmp) / tvolt, s2(jpicpt_dmp) / tvolt 
    642             WRITE (numout,9427)   t2(jpicpt_qsr) / tvolt 
    643             WRITE (numout,9428)   t2(jpicpt_nsr) / tvolt, s2(jpicpt_nsr) / tvolt 
     659            WRITE (numout,9421) ( ts2(jpt_trd_xad,jp_tem) + ts2(jpt_trd_yad,jp_tem) ) / tvolt,   & 
     660               &                ( ts2(jpt_trd_xad,jp_sal) + ts2(jpt_trd_yad,jp_sal) ) / tvolt 
     661            WRITE (numout,9422)   ts2(jpt_trd_zad,jp_tem) / tvolt, ts2(jpt_trd_zad,jp_sal) / tvolt 
     662            WRITE (numout,9423)   ts2(jpt_trd_ldf,jp_tem) / tvolt, ts2(jpt_trd_ldf,jp_sal) / tvolt 
     663            WRITE (numout,9424)   ts2(jpt_trd_zdf,jp_tem) / tvolt, ts2(jpt_trd_zdf,jp_sal) / tvolt 
     664            WRITE (numout,9425)   ts2(jpt_trd_npc,jp_tem) / tvolt, ts2(jpt_trd_npc,jp_sal) / tvolt 
     665            WRITE (numout,9426)   ts2(jpt_trd_dmp,jp_tem) / tvolt, ts2(jpt_trd_dmp,jp_sal) / tvolt 
     666            WRITE (numout,9427)   ts2(jpt_trd_qsr,jp_tem) / tvolt 
     667            WRITE (numout,9428)   ts2(jpt_trd_qns,jp_tem) / tvolt, ts2(jpt_trd_qns,jp_sal) / tvolt 
    644668            WRITE (numout,9429) 
    645             WRITE (numout,9430) (  t2(jpicpt_xad) + t2(jpicpt_yad) + t2(jpicpt_zad) + t2(jpicpt_ldf) + t2(jpicpt_zdf)   & 
    646             &                    + t2(jpicpt_npc) + t2(jpicpt_dmp) + t2(jpicpt_qsr) + t2(jpicpt_nsr) ) / tvolt,   & 
    647             &                   (  s2(jpicpt_xad) + s2(jpicpt_yad) + s2(jpicpt_zad) + s2(jpicpt_ldf) + s2(jpicpt_zdf)   & 
    648             &                    + s2(jpicpt_npc) + s2(jpicpt_dmp)                  + s2(jpicpt_nsr) ) / tvolt 
    649          ENDIF 
    650  
    651 9420     FORMAT(' tracer**2 trend at it= ', i6, ' :      temperature',   & 
    652             '               salinity', /, ' ===============================') 
     669            WRITE (numout,9430) (  ts2(jpt_trd_xad,jp_tem) + ts2(jpt_trd_yad,jp_tem) + ts2(jpt_trd_zad,jp_tem)     & 
     670               &                 + ts2(jpt_trd_ldf,jp_tem) + ts2(jpt_trd_zdf,jp_tem) + ts2(jpt_trd_npc,jp_tem)     & 
     671               &                 + ts2(jpt_trd_dmp,jp_tem) + ts2(jpt_trd_qsr,jp_tem) + ts2(jpt_trd_qns,jp_tem) )   & 
     672               &                / tvolt,   & 
     673               &                (  ts2(jpt_trd_xad,jp_sal) + ts2(jpt_trd_yad,jp_sal) + ts2(jpt_trd_zad,jp_sal)     & 
     674               &                 + ts2(jpt_trd_ldf,jp_sal) + ts2(jpt_trd_zdf,jp_sal) + ts2(jpt_trd_npc,jp_sal)     & 
     675               &                 + ts2(jpt_trd_dmp,jp_sal)                          + ts2(jpt_trd_qns,jp_sal) )   & 
     676               &                / tvolt 
     677 
     6789420     FORMAT(' tracer**2 trend at it= ',i6,' :     temperature              salinity', /,   & 
     679                ' ============================') 
    6536809421     FORMAT(' horizontal advection      * t   ', e20.13, '     ', e20.13) 
    6546819422     FORMAT(' vertical advection        * t   ', e20.13, '     ', e20.13) 
    … …  
    663690 
    664691 
    665          IF(lwp) THEN 
    666692            WRITE (numout,*) 
    667693            WRITE (numout,*) 
    668694            WRITE (numout,9440) kt 
    669             WRITE (numout,9441) ( tmo(jpicpt_xad)+tmo(jpicpt_yad)+tmo(jpicpt_zad) )/tvolt,   & 
    670             &                   ( smo(jpicpt_xad)+smo(jpicpt_yad)+smo(jpicpt_zad) )/tvolt 
    671             WRITE (numout,9442)   tmo(jpicpt_zl1)/tvolt,  smo(jpicpt_zl1)/tvolt 
    672             WRITE (numout,9443)   tmo(jpicpt_ldf)/tvolt,  smo(jpicpt_ldf)/tvolt 
    673             WRITE (numout,9444)   tmo(jpicpt_zdf)/tvolt,  smo(jpicpt_zdf)/tvolt 
    674             WRITE (numout,9445)   tmo(jpicpt_npc)/tvolt,  smo(jpicpt_npc)/tvolt 
    675             WRITE (numout,9446) ( t2(jpicpt_xad)+t2(jpicpt_yad)+t2(jpicpt_zad) )/tvolt,    & 
    676             &                   ( s2(jpicpt_xad)+s2(jpicpt_yad)+s2(jpicpt_zad) )/tvolt 
    677             WRITE (numout,9447)   t2(jpicpt_ldf)/tvolt,   s2(jpicpt_ldf)/tvolt 
    678             WRITE (numout,9448)   t2(jpicpt_zdf)/tvolt,   s2(jpicpt_zdf)/tvolt 
    679             WRITE (numout,9449)   t2(jpicpt_npc)/tvolt,   s2(jpicpt_npc)/tvolt 
    680          ENDIF 
    681  
    682 9440     FORMAT(' tracer consistency at it= ',i6,   & 
    683             ' :         temperature','                salinity',/,   & 
    684             ' ==================================') 
     695            WRITE (numout,9441) ( tsmo(jpt_trd_xad,jp_tem)+tsmo(jpt_trd_yad,jp_tem)+tsmo(jpt_trd_zad,jp_tem) )/tvolt,  & 
     696            &                   ( tsmo(jpt_trd_xad,jp_sal)+tsmo(jpt_trd_yad,jp_sal)+tsmo(jpt_trd_zad,jp_sal) )/tvolt 
     697            WRITE (numout,9442)   tsmo(jpt_trd_zl1,jp_tem)/tvolt,  tsmo(jpt_trd_zl1,jp_sal)/tvolt 
     698            WRITE (numout,9443)   tsmo(jpt_trd_ldf,jp_tem)/tvolt,  tsmo(jpt_trd_ldf,jp_sal)/tvolt 
     699            WRITE (numout,9444)   tsmo(jpt_trd_zdf,jp_tem)/tvolt,  tsmo(jpt_trd_zdf,jp_sal)/tvolt 
     700            WRITE (numout,9445)   tsmo(jpt_trd_npc,jp_tem)/tvolt,  tsmo(jpt_trd_npc,jp_sal)/tvolt 
     701            WRITE (numout,9446) ( ts2(jpt_trd_xad,jp_tem)+ts2(jpt_trd_yad,jp_tem)+ts2(jpt_trd_zad,jp_tem) )/tvolt,    & 
     702            &                   ( ts2(jpt_trd_xad,jp_sal)+ts2(jpt_trd_yad,jp_sal)+ts2(jpt_trd_zad,jp_sal) )/tvolt 
     703            WRITE (numout,9447)   ts2(jpt_trd_ldf,jp_tem)/tvolt,   ts2(jpt_trd_ldf,jp_sal)/tvolt 
     704            WRITE (numout,9448)   ts2(jpt_trd_zdf,jp_tem)/tvolt,   ts2(jpt_trd_zdf,jp_sal)/tvolt 
     705            WRITE (numout,9449)   ts2(jpt_trd_npc,jp_tem)/tvolt,   ts2(jpt_trd_npc,jp_sal)/tvolt 
     706         ENDIF 
     707 
     7089440     FORMAT(' tracer consistency at it= ',i6, ' :         temperature','                salinity',   & 
     709                /, ' ==================================') 
    6857109441     FORMAT(' 0 = horizontal+vertical advection +    ',e20.13,'       ',e20.13) 
    6867119442     FORMAT('     1st lev vertical advection         ',e20.13,'       ',e20.13) 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRD/trdicp_oce.F90

    r719 r790  
    1414   PUBLIC 
    1515 
    16    !! * Shared module variables 
    17 #if  defined key_trdtra   &&   defined key_trddyn    ||   defined key_esopa 
    18    LOGICAL, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag 
    19    LOGICAL, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag 
    20 #elif  defined key_trdtra 
    21    LOGICAL, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag 
    22    LOGICAL, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag 
    23 #elif  defined key_trddyn 
    24    LOGICAL, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag 
    25    LOGICAL, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag 
    26 #else 
    27    LOGICAL, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag 
    28    LOGICAL, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag 
    29 #endif 
    30  
    31    !! Tracers trends diagnostics parameters 
    32    !!--------------------------------------------------------------------- 
    33    INTEGER, PARAMETER ::   &  !: => tracer trends indexes <= 
    34         jpicpt_xad =  1,   &  !: x- horizontal advection 
    35         jpicpt_yad =  2,   &  !: y- horizontal advection 
    36         jpicpt_zad =  3,   &  !: z- vertical   advection 
    37         jpicpt_ldf =  4,   &  !: lateral       diffusion 
    38         jpicpt_zdf =  5,   &  !: vertical diffusion (Kz) 
    39         jpicpt_bbc =  6,   &  !: Bottom Boundary Condition (geoth. flux)  
    40         jpicpt_bbl =  7,   &  !: Bottom Boundary Layer (diffusive/convective) 
    41         jpicpt_npc =  8,   &  !: static instability mixing 
    42         jpicpt_dmp =  9,   &  !: damping 
    43         jpicpt_qsr = 10,   &  !: penetrative solar radiation 
    44         jpicpt_nsr = 11,   &  !: non solar radiation 
    45         jpicpt_zl1 = 12       !: first level vertical flux 
    46  
    47    INTEGER, PARAMETER ::   &  !: => Total tracer trends indexes <= 
    48         jptot_tra = 12        !: change it when adding/removing one indice above 
    49     
    5016   !! Momentum trends diagnostics parameters 
    5117   !!--------------------------------------------------------------------- 
    … …  
    6632        jptot_dyn = 11        !: change it when adding/removing one indice above 
    6733    
    68 #if   defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa 
    69  
    70    !! Variables used for diagnostics 
    71    !!--------------------------------------------------------------------- 
    72    REAL(wp) ::   tvolt        !: volume of the whole ocean computed at t-points 
    73    REAL(wp) ::   tvolu        !: volume of the whole ocean computed at u-points 
    74    REAL(wp) ::   tvolv        !: volume of the whole ocean computed at v-points 
    75  
    76    !! Tracers trends diagnostics variables 
    77    !!--------------------------------------------------------------------- 
    78    REAL(wp), DIMENSION(jptot_tra) ::   tmo, smo         !: tracers trends average  
    79    REAL(wp), DIMENSION(jptot_tra) ::   t2, s2           !: tracers square trends average  
    80     
    81    !! Momentum trends diagnostics variables 
    82    !!--------------------------------------------------------------------- 
    83    REAL(wp), DIMENSION(jptot_dyn) ::   umo, vmo         !: momentum trends average  
    84    REAL(wp), DIMENSION(jptot_dyn) ::   hke              !: momentum square trends average  
    85    REAL(wp) ::   rpktrd   !: potential to kinetic energy conversion 
    86    REAL(wp) ::   peke     !: conversion potential energy - kinetic energy trend 
    87  
    88 #endif 
    8934   !!---------------------------------------------------------------------- 
    9035   !!  OPA 9.0 , LOCEAN-IPSL (2005)  

  • branches/dev_001_GM/NEMO/OPA_SRC/TRD/trdmod.F90

    r719 r790  
    99#if  defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa 
    1010   !!---------------------------------------------------------------------- 
    11    !!   trd_mod          : Call the trend to be computed 
     11   !!   trd_tra          : active tracer trend manager 
     12   !!   trd_tra_adv      : pre-treatment of the tracer advection trends 
     13   !!   trd_mod          : momentum trend manager 
    1214   !!   trd_mod_init     : Initialization step 
    1315   !!---------------------------------------------------------------------- 
    … …  
    2931   REAL(wp) ::   r2dt          ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
    3032 
    31    PUBLIC trd_mod              ! called by all dynXX or traXX modules 
     33   PUBLIC trd_tra              ! called by all traXXX.F90 modules 
     34   PUBLIC trd_tra_adv          ! called by all traadv_XXX.F90 modules 
     35   PUBLIC trd_mod              ! called by all dynXXX.F90 modules 
    3236   PUBLIC trd_mod_init         ! called by opa.F90 module 
    3337 
    … …  
    4246 
    4347CONTAINS 
     48 
     49   SUBROUTINE trd_tra( kt, ktra, ktrd, ctype, ptrd2d, ptrd3d, cnbpas ) 
     50      !!--------------------------------------------------------------------- 
     51      !!                  ***  ROUTINE trd_mod  *** 
     52      !!  
     53      !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or  
     54      !!              integral constraints 
     55      !!---------------------------------------------------------------------- 
     56      INTEGER         , INTENT(in   )                                   ::   kt      ! time step 
     57      INTEGER         , INTENT(in   )                                   ::   ktra    ! tracer index 
     58      INTEGER         , INTENT(in   )                                   ::   ktrd    ! tracer trend index 
     59      CHARACTER(len=3), INTENT(in   )                                   ::   ctype   ! tracers type 'TRA' or 'TRC' 
     60      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj)    , OPTIONAL ::   ptrd2d  ! Temperature or U trend  
     61      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk), OPTIONAL ::   ptrd3d  ! Temperature or U trend  
     62      CHARACTER(len=3), INTENT(in   )                        , OPTIONAL ::   cnbpas  ! number of passage 
     63      !! 
     64      CHARACTER(len=3) ::   ccpas                                  ! number of passage 
     65!     REAL(wp), DIMENSION(jpi,jpj) ::   z2dx, z2dy                 ! workspace arrays 
     66      !!---------------------------------------------------------------------- 
     67 
     68      ccpas = 'fst'                            ! Control of optional arguments 
     69      IF( PRESENT(cnbpas) )  ccpas = cnbpas 
     70 
     71      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restarting with Euler time stepping) 
     72      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog) 
     73      ENDIF 
     74 
     75      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     76      ! I. Integral Constraints Properties for momentum and/or tracers trends 
     77      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     78 
     79      IF( ( mod(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend) )   THEN 
     80         ! 
     81         IF( lk_trdtra .AND. ctype == 'TRA' )   THEN       ! active tracer trends 
     82            IF( PRESENT(ptrd2d) ) THEN   ;   CALL trd_icp( ptrd2d, ktra, ktrd, ctype, clpas=ccpas ) 
     83            ELSE                         ;   CALL trd_icp( ptrd3d, ktra, ktrd, ctype, clpas=ccpas ) 
     84            ENDIF 
     85         ENDIF 
     86!           SELECT CASE ( ktrd ) 
     87!           CASE ( jptra_trd_ldf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_ldf, ctype )   ! lateral diff 
     88!           CASE ( jptra_trd_zdf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zdf, ctype )   ! vertical diff (Kz) 
     89!           CASE ( jptra_trd_bbc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbc, ctype )   ! bottom boundary cond 
     90!           CASE ( jptra_trd_bbl )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbl, ctype )   ! bottom boundary layer 
     91!           CASE ( jptra_trd_npc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_npc, ctype )   ! static instability mixing 
     92!           CASE ( jptra_trd_dmp )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype )   ! damping 
     93!           CASE ( jptra_trd_qsr )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype )   ! penetrative solar radiat. 
     94!           CASE ( jptra_trd_nsr )    
     95!              z2dx(:,:) = ptrdx(:,:,1)   ;   z2dy(:,:) = ptrdy(:,:,1) 
     96!              CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype )                               ! non solar radiation 
     97!           CASE ( jptra_trd_xad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype )   ! x- horiz adv 
     98!           CASE ( jptra_trd_yad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype )   ! y- horiz adv 
     99!           CASE ( jptra_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, clpas=ccpas )    ! z- adv  
     100!              CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, clpas=ccpas )    
     101!              ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 
     102!              z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 
     103!              z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 
     104!              CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )                             ! 1st z- vertical adv  
     105!           END SELECT 
     106!        END IF 
     107         ! 
     108      END IF 
     109 
     110      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     111      ! III. Mixed layer trends for active tracers 
     112      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     113 
     114      IF( lk_trdmld .AND. ctype == 'TRA' )   THEN 
     115          
     116         !----------------------------------------------------------------------------------------------- 
     117         ! W.A.R.N.I.N.G : 
     118         ! jptra_trd_ldf : called by traldf.F90 
     119         !                 at this stage we store: 
     120         !                  - the lateral geopotential diffusion (here, lateral = horizontal) 
     121         !                  - and the iso-neutral diffusion if activated  
     122         ! jptra_trd_zdf : called by trazdf.F90 
     123         !                 * in case of iso-neutral diffusion we store the vertical diffusion component in the  
     124         !                   lateral trend including the K_z contrib, which will be removed later (see trd_mld) 
     125         !----------------------------------------------------------------------------------------------- 
     126 
     127!        SELECT CASE ( ktrd ) 
     128!        CASE ( jpt_trd_zdf ) 
     129!           IF( ln_traldf_iso )   THEN 
     130!              CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' )   ! vertical diffusion (K_z) 
     131!           ELSE 
     132!              CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zdf, '3D' )   ! vertical diffusion (K_z) 
     133!           ENDIF 
     134!        CASE ( jpt_trd_nsr ) 
     135!           ptrdx(:,:,2:jpk) = 0.e0   ;   ptrdy(:,:,2:jpk) = 0.e0 
     136!           CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '2D' )                             ! air-sea : non solar flux 
     137!        CASE ( jpt_trd_bbc )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbc, '3D' )   ! bbc (geothermal flux) 
     138!        CASE DEFAULT 
     139!                                     CALL trd_mld_zint( ptrdx, ptrdy, ktra     , '3D' )   ! other 3D trends 
     140!        END SELECT 
     141 
     142      ENDIF 
     143 
     144   END SUBROUTINE trd_tra 
     145 
     146 
     147   SUBROUTINE trd_tra_adv( kt, ktra, ktrd, ctype, pf, pun, ptn, cnbpas ) 
     148      !!--------------------------------------------------------------------- 
     149      !!                  ***  ROUTINE trd_mod  *** 
     150      !!  
     151      !! ** Purpose :   transformed the i-advective flux into the i-advective trends 
     152      !! ** Method  :   i-advective trends = un. di[T] = di[fi] - tn di[un] 
     153      !!---------------------------------------------------------------------- 
     154      INTEGER         , INTENT(in   )                         ::   kt      ! time step 
     155      INTEGER         , INTENT(in   )                         ::   ktra    ! tracer index 
     156      INTEGER         , INTENT(in   )                         ::   ktrd    ! tracer trend index 
     157      CHARACTER(len=3), INTENT(in   )                         ::   ctype   ! tracers type 'TRA' or 'TRC' 
     158      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction 
     159      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction 
     160      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer  
     161      CHARACTER(len=3), INTENT(in   )                        , OPTIONAL ::   cnbpas  ! number of passage 
     162      !! 
     163      INTEGER                          ::   ji, jj, jk      ! dummy loop indices 
     164      CHARACTER(len=3) ::   ccpas                           ! number of passage 
     165      REAL(wp)                         ::   zbtr, z_hdivn   !  
     166      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt           ! 3D workspace  
     167      !!---------------------------------------------------------------------- 
     168 
     169      ccpas = 'fst'                            ! Control of optional arguments 
     170      IF( PRESENT(cnbpas) )  ccpas = cnbpas 
     171 
     172      ztrdt(:,:,:) = 0.e0 
     173      ! 
     174      IF( ccpas == 'fst' ) THEN      ! first treatment : remove the divergence 
     175         SELECT CASE( ktrd )  
     176         CASE( jpt_trd_xad )      ! i-advective trend 
     177            DO jk = 1, jpkm1 
     178               DO jj = 2, jpjm1 
     179                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     180#if defined key_zco 
     181                     zbtr    = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) ) 
     182                     z_hdivn = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              & 
     183                        &       - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) 
     184#else 
     185                     zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     186                     z_hdivn = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
     187                        &       - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) 
     188#endif 
     189                     ztrdt(ji,jj,jk) = - zbtr * (  pf(ji,jj,jk) - pf(ji-1,jj,jk)  -  ptn(ji,jj,jk) * z_hdivn  ) 
     190                  END DO 
     191               END DO 
     192            END DO 
     193            ! 
     194         CASE( jpt_trd_yad )      ! j-advective trend 
     195            DO jk = 1, jpkm1 
     196               DO jj = 2, jpjm1 
     197                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     198#if defined key_zco 
     199                     zbtr    = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) ) 
     200                     z_hdivn = (  e1v(ji,jj  ) * pun(ji,jj  ,jk)                              & 
     201                        &       - e1v(ji,jj-1) * pun(ji,jj-1,jk) ) 
     202#else 
     203                     zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     204                     z_hdivn = (  e1v(ji  ,jj) * fse3v(ji,jj  ,jk) * pun(ji,jj  ,jk)          & 
     205                        &       - e1v(ji-1,jj) * fse3v(ji,jj-1,jk) * pun(ji,jj-1,jk) ) 
     206#endif 
     207                     ztrdt(ji,jj,jk) = - zbtr * (  pf(ji,jj,jk) - pf(ji,jj-1,jk)  -  ptn(ji,jj,jk) * z_hdivn  ) 
     208                  END DO 
     209               END DO 
     210            END DO 
     211            ! 
     212         CASE( jpt_trd_zad )      ! z-advective trend 
     213            DO jk = 1, jpkm1 
     214               DO jj = 2, jpjm1 
     215                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     216                     zbtr    = 1.e0 / fse3t(ji,jj,jk) 
     217                     z_hdivn = pun(ji,jj,jk) - pun(ji,jj,jk+1) 
     218                     ztrdt(ji,jj,jk) = - zbtr * (  pf(ji,jj,jk) - pf(ji,jj,jk+1)  -  ptn(ji,jj,jk) * z_hdivn  ) 
     219                  END DO 
     220               END DO 
     221            END DO 
     222            ! 
     223         END SELECT 
     224         ! 
     225      ELSE                ! second call : just compute the trend   (TVD scheme) 
     226         SELECT CASE( ktrd )  
     227         CASE( jpt_trd_xad )      ! i-advective trend 
     228            DO jk = 1, jpkm1       
     229               DO jj = 2, jpjm1 
     230                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     231                     zbtr    = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     232                     ztrdt(ji,jj,jk) = - zbtr * (  pf(ji,jj,jk) - pf(ji-1,jj,jk)  ) 
     233                  END DO 
     234               END DO 
     235            END DO 
     236            ! 
     237         CASE( jpt_trd_yad )      ! j-advective trend 
     238            DO jk = 1, jpkm1 
     239               DO jj = 2, jpjm1 
     240                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     241                     zbtr    = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     242                     ztrdt(ji,jj,jk) = - zbtr * (  pf(ji,jj,jk) - pf(ji,jj-1,jk)  ) 
     243                  END DO 
     244               END DO 
     245            END DO 
     246            ! 
     247         CASE( jpt_trd_zad )      ! z-advective trend 
     248            DO jk = 1, jpkm1 
     249               DO jj = 2, jpjm1 
     250                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     251                     zbtr    = 1.e0 / fse3t(ji,jj,jk) 
     252                     ztrdt(ji,jj,jk) = - zbtr * (  pf(ji,jj,jk) - pf(ji,jj,jk+1)  ) 
     253                  END DO 
     254               END DO 
     255            END DO 
     256            ! 
     257         END SELECT 
     258         ! 
     259      ENDIF 
     260      ! 
     261      CALL trd_tra( kt, ktra, ktrd, ctype, ptrd3d=ztrdt)       ! trend diagnostics 
     262      ! 
     263   END SUBROUTINE trd_tra_adv 
     264 
    44265 
    45266   SUBROUTINE trd_mod( ptrdx, ptrdy, ktrd, ctype, kt, cnbpas ) 
    … …  
    50271      !!              integral constraints 
    51272      !!---------------------------------------------------------------------- 
    52       INTEGER, INTENT( in ) ::   kt                                ! time step 
    53       INTEGER, INTENT( in ) ::   ktrd                              ! tracer trend index 
    54       CHARACTER(len=3), INTENT( in ) ::   ctype                    ! momentum or tracers trends type 'DYN'/'TRA' 
    55       CHARACTER(len=3), INTENT( in ), OPTIONAL ::   cnbpas         ! number of passage 
    56       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdx ! Temperature or U trend  
    57       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdy ! Salinity    or V trend 
     273      INTEGER         , INTENT(in   )                                   ::   kt      ! time step 
     274      INTEGER         , INTENT(in   )                                   ::   ktrd    ! tracer trend index 
     275      CHARACTER(len=3), INTENT(in   )                                   ::   ctype   ! momentum trends type ='DYN' 
     276      CHARACTER(len=3), INTENT(in   )                        , OPTIONAL ::   cnbpas  ! number of passage 
     277      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk)           ::   ptrdx  ! Temperature or U trend  
     278      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk)           ::   ptrdy  ! Salinity    or V trend 
    58279      !! 
    59280      INTEGER ::   ji, ikbu, ikbum1 
    … …  
    68289      z2dx(:,:)   = 0.e0   ;   z2dy(:,:)   = 0.e0                  ! initialization of workspace arrays 
    69290 
    70       ! Control of optional arguments 
    71       ccpas = 'fst' 
     291      ccpas = 'fst'                            ! Control of optional arguments 
    72292      IF( PRESENT(cnbpas) )  ccpas = cnbpas 
    73293 
    74       IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restarting with Euler time stepping) 
     294      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (start with Euler time stepping) 
    75295      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog) 
    76296      ENDIF 
    … …  
    82302      IF( ( mod(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend) )   THEN 
    83303         ! 
    84          IF( lk_trdtra .AND. ctype == 'TRA' )   THEN       ! active tracer trends 
    85             SELECT CASE ( ktrd ) 
    86             CASE ( jptra_trd_ldf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_ldf, ctype )   ! lateral diff 
    87             CASE ( jptra_trd_zdf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zdf, ctype )   ! vertical diff (Kz) 
    88             CASE ( jptra_trd_bbc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbc, ctype )   ! bottom boundary cond 
    89             CASE ( jptra_trd_bbl )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbl, ctype )   ! bottom boundary layer 
    90             CASE ( jptra_trd_npc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_npc, ctype )   ! static instability mixing 
    91             CASE ( jptra_trd_dmp )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype )   ! damping 
    92             CASE ( jptra_trd_qsr )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype )   ! penetrative solar radiat. 
    93             CASE ( jptra_trd_nsr )    
    94                z2dx(:,:) = ptrdx(:,:,1)   ;   z2dy(:,:) = ptrdy(:,:,1) 
    95                CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype )                               ! non solar radiation 
    96             CASE ( jptra_trd_xad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype )   ! x- horiz adv 
    97             CASE ( jptra_trd_yad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype )   ! y- horiz adv 
    98             CASE ( jptra_trd_zad )                                                         ! z- vertical adv  
    99                CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, clpas=ccpas )    
    100                ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 
    101                z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 
    102                z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 
    103                CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )                             ! 1st z- vertical adv  
    104             END SELECT 
    105          END IF 
    106  
    107304         IF( lk_trddyn .AND. ctype == 'DYN' )   THEN       ! momentum trends  
    108305            ! 
    … …  
    200397         ! 
    201398      ENDIF 
    202  
    203       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    204       ! III. Mixed layer trends for active tracers 
    205       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    206  
    207       IF( lk_trdmld .AND. ctype == 'TRA' )   THEN 
    208           
    209          !----------------------------------------------------------------------------------------------- 
    210          ! W.A.R.N.I.N.G : 
    211          ! jptra_trd_ldf : called by traldf.F90 
    212          !                 at this stage we store: 
    213          !                  - the lateral geopotential diffusion (here, lateral = horizontal) 
    214          !                  - and the iso-neutral diffusion if activated  
    215          ! jptra_trd_zdf : called by trazdf.F90 
    216          !                 * in case of iso-neutral diffusion we store the vertical diffusion component in the  
    217          !                   lateral trend including the K_z contrib, which will be removed later (see trd_mld) 
    218          !----------------------------------------------------------------------------------------------- 
    219  
    220          SELECT CASE ( ktrd ) 
    221          CASE ( jptra_trd_xad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_xad, '3D' )   ! merid. advection 
    222          CASE ( jptra_trd_yad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_yad, '3D' )   ! zonal  advection 
    223          CASE ( jptra_trd_zad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zad, '3D' )   ! vertical advection 
    224          CASE ( jptra_trd_ldf )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' )   ! lateral diffusive 
    225          CASE ( jptra_trd_bbl )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbl, '3D' )   ! bottom boundary layer 
    226          CASE ( jptra_trd_zdf ) 
    227             IF( ln_traldf_iso )   THEN 
    228                CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' )   ! vertical diffusion (K_z) 
    229             ELSE 
    230                CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zdf, '3D' )   ! vertical diffusion (K_z) 
    231             ENDIF 
    232          CASE ( jptra_trd_dmp )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_dmp, '3D' )   ! internal 3D restoring (tradmp) 
    233          CASE ( jptra_trd_qsr )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '3D' )   ! air-sea : penetrative sol radiat 
    234          CASE ( jptra_trd_nsr ) 
    235             ptrdx(:,:,2:jpk) = 0.e0   ;   ptrdy(:,:,2:jpk) = 0.e0 
    236             CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '2D' )                             ! air-sea : non penetr sol radiat 
    237          CASE ( jptra_trd_bbc )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbc, '3D' )   ! bottom bound cond (geoth flux) 
    238          CASE ( jptra_trd_atf )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_atf, '3D' )   ! asselin numerical 
    239          CASE ( jptra_trd_npc )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_npc, '3D' )   ! non penetr convect adjustment 
    240          END SELECT 
    241  
    242       ENDIF 
    243  
     399      ! 
    244400   END SUBROUTINE trd_mod 
    245401 
    … …  
    254410 
    255411CONTAINS 
     412 
     413   SUBROUTINE trd_tra( kt, ktra, ktrd, ctype, ptrd2d, ptrd3d, cnbpas ) 
     414      INTEGER ::   kt, ktra, ktrd 
     415      CHARACTER(len=3) ::   ctype   ! tracers type 'TRA' or 'TRC' 
     416      REAL, DIMENSION(:,:)  , OPTIONAL ::   ptrd2d  ! Temperature or U trend  
     417      REAL, DIMENSION(:,:,:), OPTIONAL ::   ptrd3d  ! Temperature or U trend  
     418      CHARACTER(len=3)      , OPTIONAL ::   cnbpas  ! number of passage 
     419      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', kt, ktra, ktrd, ctype,   & 
     420         &                                                               ptrd2d(1,1), ptrd3d(1,1,1), cnbpas 
     421   END SUBROUTINE trd_tra 
     422 
     423   SUBROUTINE trd_tra_adv( kt, ktra, ktrd, ctype, pf, pun, ptn, cnbpas ) 
     424      INTEGER ::   kt, ktra, ktrd   
     425      CHARACTER(len=3) ::   ctype 
     426      REAL, DIMENSION(:,:,:) ::   pf, pun, ptn 
     427      CHARACTER(len=3), OPTIONAL ::   cnbpas 
     428      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', kt, ktra, ktrd, ctype, pf(1,1,1),   & 
     429         &                                                               pun(1,1,1), ptn(1,1,1), cnbpas 
     430   END SUBROUTINE trd_tra_adv 
     431 
    256432   SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt, cnbpas)   ! Empty routine 
    257       REAL, DIMENSION(:,:,:), INTENT( in ) ::   & 
    258           ptrd3dx,                     &                           ! Temperature or U trend  
    259           ptrd3dy                                                  ! Salinity    or V trend 
    260       INTEGER, INTENT( in ) ::   ktrd                              ! momentum or tracer trend index 
    261       INTEGER, INTENT( in ) ::   kt                                ! Time step 
     433      REAL, DIMENSION(:,:,:) ::   ptrd3dx, ptrd3dy     
     434      INTEGER ::   ktrd, kt 
    262435      CHARACTER(len=3), INTENT( in ) ::  ctype                     ! momentum or tracers trends type 
    263436      CHARACTER(len=3), INTENT( in ), OPTIONAL ::   cnbpas         ! number of passage 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRD/trdmod_oce.F90

    r719 r790  
    3232   LOGICAL , PUBLIC ::   l_trddyn = .FALSE.             !: momentum trend flag 
    3333# endif 
     34#if  defined key_trdtra   &&   defined key_trddyn    ||   defined key_esopa 
     35   LOGICAL, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag 
     36   LOGICAL, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag 
     37#elif  defined key_trdtra 
     38   LOGICAL, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag 
     39   LOGICAL, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag 
     40#elif  defined key_trddyn 
     41   LOGICAL, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag 
     42   LOGICAL, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag 
     43#else 
     44   LOGICAL, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag 
     45   LOGICAL, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag 
     46#endif 
     47 
    3448 
    3549   !!* Active tracers trends indexes 
    36    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_xad =  1   !: x- horizontal advection 
    37    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_yad =  2   !: y- horizontal advection 
    38    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zad =  3   !: z- vertical   advection 
    39    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_ldf =  4   !: lateral       diffusion 
    40    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zdf =  5   !: vertical diffusion (Kz) 
    41    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbc =  6   !: Bottom Boundary Condition (geoth. flux)  
    42    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbl =  7   !: Bottom Boundary Layer (diffusive/convective) 
    43    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_npc =  8   !: static instability mixing 
    44    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_dmp =  9   !: damping 
    45    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_qsr = 10   !: penetrative solar radiation 
    46    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_nsr = 11   !: non solar radiation 
    47    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_atf = 12   !: Asselin correction 
     50   INTEGER, PUBLIC, PARAMETER ::   jpt_trd = 13        !: change it when adding/removing one indice above 
     51 
     52   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_xad =  1   !: x- horizontal advection 
     53   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_yad =  2   !: y- horizontal advection 
     54   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_zad =  3   !: z- vertical   advection 
     55   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_ldf =  4   !: lateral       diffusion 
     56   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_zdf =  5   !: vertical diffusion (Kz) 
     57   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_bbc =  6   !: Bottom Boundary Condition (geoth. flux)  
     58   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_bbl =  7   !: Bottom Boundary Layer (diffusive/convective) 
     59   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_npc =  8   !: static instability mixing 
     60   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_dmp =  9   !: damping 
     61   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_qsr = 10   !: penetrative solar radiation 
     62   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_qns = 11   !: non solar heat flux 
     63   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_atf = 12   !: Asselin correction 
     64   INTEGER, PUBLIC, PARAMETER ::   jpt_trd_zl1 = 13   !: first level vertical flux (lk_vvl=F) 
     65 
    4866    
    4967   !!* Momentum trends indexes 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRD/trends_manager.F90

    r772 r790  
    1 MODULE trdmod 
     1MODULE trends_manager 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  trdmod  *** 
     3   !!                       ***  MODULE  trends_manager  *** 
    44   !! Ocean diagnostics:  ocean tracers and dynamic trends 
    55   !!===================================================================== 
    … …  
    88   !!---------------------------------------------------------------------- 
    99#if  defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa 
    10    !!---------------------------------------------------------------------- 
    11    !!   trd_mod          : Call the trend to be computed 
    12    !!   trd_mod_init     : Initialization step 
    13    !!---------------------------------------------------------------------- 
    14    USE phycst                  ! physical constants 
    15    USE oce                     ! ocean dynamics and tracers variables 
    16    USE dom_oce                 ! ocean space and time domain variables 
    17    USE zdf_oce                 ! ocean vertical physics variables 
    18    USE trdmod_oce              ! ocean variables trends 
    19    USE ldftra_oce              ! ocean active tracers lateral physics 
    20    USE trdvor                  ! ocean vorticity trends  
    21    USE trdicp                  ! ocean bassin integral constraints properties 
    22    USE trdmld                  ! ocean active mixed layer tracers trends  
    23    USE in_out_manager          ! I/O manager 
    24    USE taumod                  ! surface ocean stress 
    2510 
    26    IMPLICIT NONE 
    27    PRIVATE 
    28  
    29    REAL(wp) ::   r2dt          ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
    30  
    31    PUBLIC trd_mod              ! called by all dynXX or traXX modules 
    32    PUBLIC trd_mod_init         ! called by opa.F90 module 
    33  
    34    !! * Substitutions 
    35 #  include "domzgr_substitute.h90" 
    36 #  include "vectopt_loop_substitute.h90" 
    37    !!---------------------------------------------------------------------- 
    38    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    39    !! $Header$  
    40    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    41    !!---------------------------------------------------------------------- 
    42  
    43 CONTAINS 
    44  
    45    SUBROUTINE trd_mod( ptrdx, ptrdy, ktrd, ctype, kt, cnbpas ) 
    46       !!--------------------------------------------------------------------- 
    47       !!                  ***  ROUTINE trd_mod  *** 
    48       !!  
    49       !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or  
    50       !!              integral constraints 
    51       !!---------------------------------------------------------------------- 
    52       INTEGER, INTENT( in ) ::   kt                                ! time step 
    53       INTEGER, INTENT( in ) ::   ktrd                              ! tracer trend index 
    54       CHARACTER(len=3), INTENT( in ) ::   ctype                    ! momentum or tracers trends type 'DYN'/'TRA' 
    55       CHARACTER(len=3), INTENT( in ), OPTIONAL ::   cnbpas         ! number of passage 
    56       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdx ! Temperature or U trend  
    57       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdy ! Salinity    or V trend 
    58       !! 
    59       INTEGER ::   ji, ikbu, ikbum1 
    60       INTEGER ::   jj, ikbv, ikbvm1 
    61       CHARACTER(len=3) ::   ccpas                                  ! number of passage 
    62       REAL(wp) ::   zua, zva                                       ! scalars 
    63       REAL(wp), DIMENSION(jpi,jpj) ::   ztswu, ztswv               ! 2D workspace 
    64       REAL(wp), DIMENSION(jpi,jpj) ::   ztbfu, ztbfv               ! 2D workspace 
    65       REAL(wp), DIMENSION(jpi,jpj) ::   z2dx, z2dy                 ! workspace arrays 
    66       !!---------------------------------------------------------------------- 
    67  
    68       z2dx(:,:)   = 0.e0   ;   z2dy(:,:)   = 0.e0                  ! initialization of workspace arrays 
    69  
    70       ! Control of optional arguments 
    71       ccpas = 'fst' 
    72       IF( PRESENT(cnbpas) )  ccpas = cnbpas 
    73  
    74       IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restarting with Euler time stepping) 
    75       ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog) 
    76       ENDIF 
    77  
    78       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    79       ! I. Integral Constraints Properties for momentum and/or tracers trends 
    80       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    81  
    82       IF( ( mod(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend) )   THEN 
    83          ! 
    84          IF( lk_trdtra .AND. ctype == 'TRA' )   THEN       ! active tracer trends 
    85             SELECT CASE ( ktrd ) 
    86             CASE ( jptra_trd_ldf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_ldf, ctype )   ! lateral diff 
    87             CASE ( jptra_trd_zdf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zdf, ctype )   ! vertical diff (Kz) 
    88             CASE ( jptra_trd_bbc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbc, ctype )   ! bottom boundary cond 
    89             CASE ( jptra_trd_bbl )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbl, ctype )   ! bottom boundary layer 
    90             CASE ( jptra_trd_npc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_npc, ctype )   ! static instability mixing 
    91             CASE ( jptra_trd_dmp )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype )   ! damping 
    92             CASE ( jptra_trd_qsr )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype )   ! penetrative solar radiat. 
    93             CASE ( jptra_trd_nsr )    
    94                z2dx(:,:) = ptrdx(:,:,1)   ;   z2dy(:,:) = ptrdy(:,:,1) 
    95                CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype )                               ! non solar radiation 
    96             CASE ( jptra_trd_xad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype )   ! x- horiz adv 
    97             CASE ( jptra_trd_yad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype )   ! y- horiz adv 
    98             CASE ( jptra_trd_zad )                                                         ! z- vertical adv  
    99                CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, clpas=ccpas )    
    100                ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 
    101                z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 
    102                z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 
    103                CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )                             ! 1st z- vertical adv  
    104             END SELECT 
    105          END IF 
    106  
    107          IF( lk_trddyn .AND. ctype == 'DYN' )   THEN       ! momentum trends  
    108             ! 
    109             SELECT CASE ( ktrd ) 
    110             CASE ( jpdyn_trd_hpg )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_hpg, ctype )   ! hydrost. pressure grad 
    111             CASE ( jpdyn_trd_keg )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_keg, ctype )   ! KE gradient  
    112             CASE ( jpdyn_trd_rvo )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_rvo, ctype )   ! relative vorticity  
    113             CASE ( jpdyn_trd_pvo )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_pvo, ctype )   ! planetary vorticity 
    114             CASE ( jpdyn_trd_ldf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_ldf, ctype )   ! lateral diffusion  
    115             CASE ( jpdyn_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_zad, ctype )   ! vertical advection  
    116             CASE ( jpdyn_trd_spg )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_spg, ctype )   ! surface pressure grad. 
    117             CASE ( jpdyn_trd_dat )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_dat, ctype )   ! damping term 
    118             CASE ( jpdyn_trd_zdf )                                                         ! vertical diffusion  
    119                ! subtract surface forcing/bottom friction trends  
    120                ! from vertical diffusive momentum trends 
    121                ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0 
    122                ztbfu(:,:) = 0.e0   ;   ztbfv(:,:) = 0.e0   
    123                DO jj = 2, jpjm1    
    124                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    125                      ! save the surface forcing momentum fluxes 
    126                      ztswu(ji,jj) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) 
    127                      ztswv(ji,jj) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 
    128                      ! save bottom friction momentum fluxes 
    129                      ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) 
    130                      ikbv   = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) ) 
    131                      ikbum1 = MAX( ikbu-1, 1 ) 
    132                      ikbvm1 = MAX( ikbv-1, 1 ) 
    133                      zua = ua(ji,jj,ikbum1) * r2dt + ub(ji,jj,ikbum1) 
    134                      zva = va(ji,jj,ikbvm1) * r2dt + vb(ji,jj,ikbvm1) 
    135                      ztbfu(ji,jj) = - avmu(ji,jj,ikbu) * zua / ( fse3u(ji,jj,ikbum1)*fse3uw(ji,jj,ikbu) ) 
    136                      ztbfv(ji,jj) = - avmv(ji,jj,ikbv) * zva / ( fse3v(ji,jj,ikbvm1)*fse3vw(ji,jj,ikbv) ) 
    137                      ! 
    138                      ptrdx(ji,jj,1     ) = ptrdx(ji,jj,1     ) - ztswu(ji,jj) 
    139                      ptrdy(ji,jj,1     ) = ptrdy(ji,jj,1     ) - ztswv(ji,jj) 
    140                      ptrdx(ji,jj,ikbum1) = ptrdx(ji,jj,ikbum1) - ztbfu(ji,jj) 
    141                      ptrdy(ji,jj,ikbvm1) = ptrdy(ji,jj,ikbvm1) - ztbfv(ji,jj) 
    142                   END DO 
    143                END DO 
    144                ! 
    145                CALL trd_icp( ptrdx, ptrdy, jpicpd_zdf, ctype )    
    146                CALL trd_icp( ztswu, ztswv, jpicpd_swf, ctype )                               ! wind stress forcing term 
    147                CALL trd_icp( ztbfu, ztbfv, jpicpd_bfr, ctype )                               ! bottom friction term 
    148             END SELECT 
    149             ! 
    150          END IF 
    151          ! 
    152       END IF 
    153  
    154       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    155       ! II. Vorticity trends 
    156       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    157  
    158       IF( lk_trdvor .AND. ctype == 'DYN' )   THEN 
    159          ! 
    160          SELECT CASE ( ktrd )  
    161          CASE ( jpdyn_trd_hpg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_prg )   ! Hydrostatique Pressure Gradient  
    162          CASE ( jpdyn_trd_keg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_keg )   ! KE Gradient  
    163          CASE ( jpdyn_trd_rvo )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_rvo )   ! Relative Vorticity  
    164          CASE ( jpdyn_trd_pvo )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_pvo )   ! Planetary Vorticity Term  
    165          CASE ( jpdyn_trd_ldf )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_ldf )   ! Horizontal Diffusion  
    166          CASE ( jpdyn_trd_zad )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_zad )   ! Vertical Advection  
    167          CASE ( jpdyn_trd_spg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_spg )   ! Surface Pressure Grad.  
    168          CASE ( jpdyn_trd_dat )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_bev )   ! Beta V   
    169          CASE ( jpdyn_trd_zdf )                                                      ! Vertical Diffusion  
    170             ! subtract surface forcing/bottom friction trends  
    171             ! from vertical diffusive momentum trends 
    172             ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0 
    173             ztbfu(:,:) = 0.e0   ;   ztbfv(:,:) = 0.e0   
    174             DO jj = 2, jpjm1    
    175                DO ji = fs_2, fs_jpim1   ! vector opt. 
    176                   ! save the surface forcing momentum fluxes 
    177                   ztswu(ji,jj) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) 
    178                   ztswv(ji,jj) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 
    179                   ! save bottom friction momentum fluxes 
    180                   ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) 
    181                   ikbv   = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) ) 
    182                   ikbum1 = MAX( ikbu-1, 1 ) 
    183                   ikbvm1 = MAX( ikbv-1, 1 ) 
    184                   zua = ua(ji,jj,ikbum1) * r2dt + ub(ji,jj,ikbum1) 
    185                   zva = va(ji,jj,ikbvm1) * r2dt + vb(ji,jj,ikbvm1) 
    186                   ztbfu(ji,jj) = - avmu(ji,jj,ikbu) * zua / ( fse3u(ji,jj,ikbum1)*fse3uw(ji,jj,ikbu) ) 
    187                   ztbfv(ji,jj) = - avmv(ji,jj,ikbv) * zva / ( fse3v(ji,jj,ikbvm1)*fse3vw(ji,jj,ikbv) ) 
    188                   ! 
    189                   ptrdx(ji,jj,1     ) = ptrdx(ji,jj,1     ) - ztswu(ji,jj) 
    190                   ptrdx(ji,jj,ikbum1) = ptrdx(ji,jj,ikbum1) - ztbfu(ji,jj) 
    191                   ptrdy(ji,jj,1     ) = ptrdy(ji,jj,1     ) - ztswv(ji,jj) 
    192                   ptrdy(ji,jj,ikbvm1) = ptrdy(ji,jj,ikbvm1) - ztbfv(ji,jj) 
    193                END DO 
    194             END DO 
    195             ! 
    196             CALL trd_vor_zint( ptrdx, ptrdy, jpvor_zdf )    
    197             CALL trd_vor_zint( ztswu, ztswv, jpvor_swf )                               ! Wind stress forcing term 
    198             CALL trd_vor_zint( ztbfu, ztbfv, jpvor_bfr )                               ! Bottom friction term 
    199          END SELECT 
    200          ! 
    201       ENDIF 
    202  
    203       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    204       ! III. Mixed layer trends for active tracers 
    205       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    206  
    207       IF( lk_trdmld .AND. ctype == 'TRA' )   THEN 
    208           
    209          !----------------------------------------------------------------------------------------------- 
    210          ! W.A.R.N.I.N.G : 
    211          ! jptra_trd_ldf : called by traldf.F90 
    212          !                 at this stage we store: 
    213          !                  - the lateral geopotential diffusion (here, lateral = horizontal) 
    214          !                  - and the iso-neutral diffusion if activated  
    215          ! jptra_trd_zdf : called by trazdf.F90 
    216          !                 * in case of iso-neutral diffusion we store the vertical diffusion component in the  
    217          !                   lateral trend including the K_z contrib, which will be removed later (see trd_mld) 
    218          !----------------------------------------------------------------------------------------------- 
    219  
    220          SELECT CASE ( ktrd ) 
    221          CASE ( jptra_trd_xad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_xad, '3D' )   ! merid. advection 
    222          CASE ( jptra_trd_yad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_yad, '3D' )   ! zonal  advection 
    223          CASE ( jptra_trd_zad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zad, '3D' )   ! vertical advection 
    224          CASE ( jptra_trd_ldf )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' )   ! lateral diffusive 
    225          CASE ( jptra_trd_bbl )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbl, '3D' )   ! bottom boundary layer 
    226          CASE ( jptra_trd_zdf ) 
    227             IF( ln_traldf_iso )   THEN 
    228                CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' )   ! vertical diffusion (K_z) 
    229             ELSE 
    230                CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zdf, '3D' )   ! vertical diffusion (K_z) 
    231             ENDIF 
    232          CASE ( jptra_trd_dmp )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_dmp, '3D' )   ! internal 3D restoring (tradmp) 
    233          CASE ( jptra_trd_qsr )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '3D' )   ! air-sea : penetrative sol radiat 
    234          CASE ( jptra_trd_nsr ) 
    235             ptrdx(:,:,2:jpk) = 0.e0   ;   ptrdy(:,:,2:jpk) = 0.e0 
    236             CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '2D' )                             ! air-sea : non penetr sol radiat 
    237          CASE ( jptra_trd_bbc )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbc, '3D' )   ! bottom bound cond (geoth flux) 
    238          CASE ( jptra_trd_atf )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_atf, '3D' )   ! asselin numerical 
    239          CASE ( jptra_trd_npc )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_npc, '3D' )   ! non penetr convect adjustment 
    240          END SELECT 
    241  
    242       ENDIF 
    243  
    244    END SUBROUTINE trd_mod 
    245  
    246 #   else 
    247    !!---------------------------------------------------------------------- 
    248    !!   Default case :                                         Empty module 
    249    !!---------------------------------------------------------------------- 
    250    USE trdmod_oce      ! ocean variables trends 
    251    USE trdvor          ! ocean vorticity trends  
    252    USE trdicp          ! ocean bassin integral constraints properties 
    253    USE trdmld          ! ocean active mixed layer tracers trends  
    254  
    255 CONTAINS 
    256    SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt, cnbpas)   ! Empty routine 
    257       REAL, DIMENSION(:,:,:), INTENT( in ) ::   & 
    258           ptrd3dx,                     &                           ! Temperature or U trend  
    259           ptrd3dy                                                  ! Salinity    or V trend 
    260       INTEGER, INTENT( in ) ::   ktrd                              ! momentum or tracer trend index 
    261       INTEGER, INTENT( in ) ::   kt                                ! Time step 
    262       CHARACTER(len=3), INTENT( in ) ::  ctype                     ! momentum or tracers trends type 
    263       CHARACTER(len=3), INTENT( in ), OPTIONAL ::   cnbpas         ! number of passage 
    264       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1) 
    265       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptrd3dy(1,1,1) 
    266       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd 
    267       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype 
    268       WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt 
    269       WRITE(*,*) ' "   ": You should not have seen this print! error ?', cnbpas 
    270    END SUBROUTINE trd_mod 
    271 #   endif 
    272  
    273    SUBROUTINE trd_mod_init 
    274       !!---------------------------------------------------------------------- 
    275       !!                  ***  ROUTINE trd_mod_init  *** 
    276       !!  
    277       !! ** Purpose :   Initialization of activated trends 
    278       !!---------------------------------------------------------------------- 
    279       USE in_out_manager          ! I/O manager 
    280  
    281       NAMELIST/namtrd/ ntrd, nctls, ln_trdmld_restart, ucf, ln_trdmld_instant 
    282       !!---------------------------------------------------------------------- 
    283  
    284       IF( l_trdtra .OR. l_trddyn )   THEN 
    285          REWIND( numnam ) 
    286          READ  ( numnam, namtrd )      ! namelist namtrd : trends diagnostic 
    287  
    288          IF(lwp) THEN 
    289             WRITE(numout,*) 
    290             WRITE(numout,*) ' trd_mod_init : Momentum/Tracers trends' 
    291             WRITE(numout,*) ' ~~~~~~~~~~~~~' 
    292             WRITE(numout,*) '       Namelist namtrd : set trends parameters' 
    293             WRITE(numout,*) '           * frequency of trends diagnostics   ntrd               = ', ntrd 
    294             WRITE(numout,*) '           * control surface type              nctls              = ', nctls 
    295             WRITE(numout,*) '           * restart for ML diagnostics        ln_trdmld_restart  = ', ln_trdmld_restart 
    296             WRITE(numout,*) '           * instantaneous or mean ML T/S      ln_trdmld_instant  = ', ln_trdmld_instant 
    297             WRITE(numout,*) '           * unit conversion factor            ucf                = ', ucf 
    298         ENDIF 
    299       ENDIF 
    300       ! 
    301       IF( lk_trddyn .OR. lk_trdtra )    CALL trd_icp_init       ! integral constraints trends 
    302       IF( lk_trdmld                )    CALL trd_mld_init       ! mixed-layer trends (active  tracers)   
    303       IF( lk_trdvor                )    CALL trd_vor_init       ! vorticity trends         
    304       ! 
    305    END SUBROUTINE trd_mod_init 
     11#endif 
    30612 
    30713   !!====================================================================== 
    308 END MODULE trdmod 
     14END MODULE trends_manager 

  • branches/dev_001_GM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r719 r790  
    12911291         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    12921292!!bug gm jpttdzdf ==> jpttkpp 
    1293          CALL trd_mod(ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt) 
     1293         CALL trd_mod(ztrdt, ztrds, jpt_trd_zdf, 'TRA', kt) 
    12941294      ENDIF 
    12951295 

  • branches/dev_001_GM/NEMO/OPA_SRC/oce.F90

    r719 r790  
    44   !! Ocean        :  dynamics and active tracers defined in memory  
    55   !!====================================================================== 
    6    !! History : 
    7    !!   8.5  !  02-11  (G. Madec)  F90: Free form and module 
    8    !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
     6   !! History :   1.0  !  02-11  (G. Madec)  F90: Free form and module 
     7   !!             2.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    98   !!---------------------------------------------------------------------- 
    10    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    11    !! $Header$  
    12    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     9   !! NEMO/OPA 2.0 , LOCEAN-IPSL (2007)  
     10   !! $Id:$  
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1312   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1513   USE par_oce      ! ocean parameters 
    1614 
    1715   IMPLICIT NONE 
    1816   PRIVATE 
     17 
    1918 
    2019   !! Physics and algorithm flags 
    … …  
    2322   INTEGER, PUBLIC ::   nn_dynhpg_rst   = 0        !: add dynhpg implicit variables in restart ot not 
    2423 
    25    !! dynamics and tracer fields 
    26    !! -------------------------- 
    27    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    28       ! before !  now      !  after  !      ! the after trends becomes the fields 
    29       ! fields !  fields   !  trends !      ! only in dyn(tra)_zdf and dyn(tra)_nxt 
    30       ub       ,  un       ,  ua     ,   &  !: i-horizontal velocity (m/s) 
    31       vb       ,  vn       ,  va     ,   &  !: j-horizontal velocity (m/s) 
    32                   wn       ,             &  !: vertical velocity (m/s) 
    33       rotb     ,  rotn     ,             &  !: relative vorticity (1/s) 
    34       hdivb    ,  hdivn    ,             &  !: horizontal divergence (1/s) 
    35       tb       ,  tn       ,  ta     ,   &  !: potential temperature (celcius) 
    36       sb       ,  sn       ,  sa            !: salinity (psu) 
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    38       rhd ,                              &  !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
    39       rhop,                              &  !: potential volumic mass (kg/m3) 
    40       rn2                                   !: brunt-vaisala frequency (1/s2) 
     24   !! dynamics and tracer fields              ! before ! now    ! after  !   the after trends becomes the fields 
     25   !! --------------------------              ! fields ! fields ! trends !   only in dyn(tra)_zdf and dyn(tra)_nxt 
     26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ub    ,  un    ,  ua    !: i-horizontal velocity (m/s) 
     27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   vb    ,  vn    ,  va    !: j-horizontal velocity (m/s) 
     28   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::            wn             !: vertical velocity (m/s) 
     29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rotb  ,  rotn           !: relative vorticity (1/s) 
     30   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   hdivb ,  hdivn          !: horizontal divergence (1/s) 
     31   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   tb    ,  tn    ,  ta    !: potential temperature (celcius) 
     32   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   sb    ,  sn    ,  sa    !: salinity (psu) 
     33   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhd                     !: in situ density anomalie rhd=(rho-rau0)/rau0 
     34   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhop                    !: potential volumic mass (kg/m3) 
     35   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rn2                     !: brunt-vaisala frequency (1/s2) 
    4136 
    4237      !! advection scheme choice 
    4338      !! ----------------------- 
     39!!gm  only for trcadv...   be be suppressed 
    4440      CHARACTER(len=3), PUBLIC  ::   l_adv   !: 'ce2' centre scheme used 
    4541         !                                   !: 'tvd' TVD scheme used 
    … …  
    4945   !! surface pressure gradient 
    5046   !! ------------------------- 
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    52       spgu, spgv             !: horizontal surface pressure gradient 
     47   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   spgu, spgv                  !: horizontal surface pressure gradient 
    5348 
    5449   !! interpolated gradient (only used in zps case) 
    5550   !! --------------------- 
    56    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    57       gtu, gsu, gru,      &  !: t-, s- and rd horizontal gradient at u- and  
    58       gtv, gsv, grv          !: v-points at bottom ocean level  
     51   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gtu, gsu, gru               !: t-, s- and rd horizontal gradient at u- and  
     52   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gtv, gsv, grv               !: v-points at bottom ocean level  
    5953 
    6054   !! free surface 
    6155   !! ------------ 
    62    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    63       sshb , sshn ,        &  !: before, now sea surface height (meters) 
    64       sshu , sshv ,        &  !: sea surface height at u- and v- point 
    65       sshbb, ssha             !: before before sea surface height at t-point 
     56   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshb , sshn                 !: before, now sea surface height (meters) 
     57   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshu , sshv                 !: sea surface height at u- and v- point 
     58   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshbb, ssha                 !: before before sea surface height at t-point 
    6659 
    6760#if defined key_dynspg_rl   ||   defined key_esopa 
    6861   !! rigid-lid formulation 
    6962   !! --------------------- 
    70    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    71       bsfb, bsfn,         &  !: before, now barotropic streamfunction (m3/s) 
    72       bsfd                   !: now trend of barotropic streamfunction (m3/s2) 
     63   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bsfb, bsfn                 !: before, now barotropic streamfunction [m3/s] 
     64   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bsfd                       !: now barotropic streamfunction trend   [m3/s2] 
    7365#endif 
     66 
    7467   !!---------------------------------------------------------------------- 
    7568END MODULE oce 

  • branches/dev_001_GM/NEMO/OPA_SRC/par_oce.F90

    r778 r790  
    99   !!---------------------------------------------------------------------- 
    1010   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2007)  
    11    !! $Id:$  
     11   !! $Id$  
    1212   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1313   !!---------------------------------------------------------------------- 
    … …  
    9898#endif 
    9999 
     100   !!--------------------------------------------------------------------- 
     101   !! Temperature/salinity indices 
     102   !!--------------------------------------------------------------------- 
     103 
     104   INTEGER, PARAMETER ::   jp_tem = 1   !: index of temperature in the tsb, tsns &, tsa arrays 
     105   INTEGER, PARAMETER ::   jp_sal = 2   !: index of salinity    in the tsb, tsns &, tsa arrays 
     106 
     107 
    100108   !!====================================================================== 
    101109END MODULE par_oce 

  • branches/dev_001_GM/NEMO/OPA_SRC/prtctl.F90

    r719 r790  
    11MODULE prtctl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE prtctl   *** 
    44   !! Ocean system   : print all SUM trends for each processor domain 
    5    !!============================================================================== 
     5   !!====================================================================== 
     6   !! History :  2.0  !  05-07  (C. Talandier) original code 
     7   !!---------------------------------------------------------------------- 
    68   USE dom_oce          ! ocean space and time domain variables 
    79   USE in_out_manager   ! I/O manager 
    … …  
    1113   PRIVATE 
    1214 
    13    !! * Module declaration 
    1415   INTEGER, DIMENSION(:), ALLOCATABLE :: numid 
    15    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   &  !: 
    16       nlditl , nldjtl ,   &  !: first, last indoor index for each i-domain 
     16   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl ,   &  !: first, last indoor index for each i-domain 
    1717      nleitl , nlejtl ,   &  !: first, last indoor index for each j-domain 
    1818      nimpptl, njmpptl,   &  !: i-, j-indexes for each processor 
    … …  
    2020      ibonitl, ibonjtl 
    2121 
    22    REAL(wp), DIMENSION(:), ALLOCATABLE ::   &  !: 
    23       t_ctll , s_ctll ,   &  !: previous trend values 
     22   REAL(wp), DIMENSION(:), ALLOCATABLE ::   t_ctll , s_ctll ,   &  !: previous trend values 
    2423      u_ctll , v_ctll 
    2524 
    2625   INTEGER ::   ktime        !: time step 
    2726 
    28    !! * Routine accessibility 
    2927   PUBLIC prt_ctl         ! called by all subroutines 
    3028   PUBLIC prt_ctl_info    ! called by all subroutines 
    3129   PUBLIC prt_ctl_init    ! called by opa.F90 
     30 
    3231   !!---------------------------------------------------------------------- 
    33    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    34    !! $Header$  
    35    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     32   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008) 
     33   !! $Id:$  
     34   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    3635   !!---------------------------------------------------------------------- 
    3736 
    … …  
    7473      !!                    kdim    : k- direction for 3D arrays  
    7574      !!                    clinfo3 : additional information  
    76       !! 
    77       !! History : 
    78       !!   9.0  !  05-07  (C. Talandier) original code 
    79       !!---------------------------------------------------------------------- 
    80       !! * Arguments 
     75      !!---------------------------------------------------------------------- 
    8176      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_1 
    8277      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1 
    … …  
    9085      INTEGER                   , INTENT(in), OPTIONAL :: kdim 
    9186      CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo3 
    92  
    93       !! * Local declarations 
    94       INTEGER :: overlap, jn, sind, eind, kdir,j_id 
     87      !! 
    9588      CHARACTER (len=15) :: cl2 
    96       REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
     89      INTEGER  ::   overlap, jn, sind, eind, kdir,j_id 
     90      REAL(wp) ::   zsum1, zsum2, zvctl1, zvctl2 
    9791      REAL(wp), DIMENSION(jpi,jpj) :: ztab2d_1, ztab2d_2 
    9892      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 
    … …  
    125119      IF( PRESENT(mask2)   )  zmask2  (:,:,:)= mask2  (:,:,:) 
    126120 
    127       IF( lk_mpp )   THEN 
    128          ! processor number 
     121      IF( lk_mpp )   THEN      ! processor number 
    129122         sind = narea 
    130123         eind = narea 
    131       ELSE 
    132          ! processors total number 
     124      ELSE                     ! processors total number 
    133125         sind = 1 
    134126         eind = ijsplt 

  • branches/dev_001_GM/NEMO/OPA_SRC/step.F90

    r719 r790  
    44   !! Time-stepping    : manager of the ocean, tracer and ice time stepping 
    55   !!====================================================================== 
    6    !! History :        !  91-03  ()  Original code 
    7    !!                  !  91-11  (G. Madec) 
    8    !!                  !  92-06  (M. Imbard)  add a first output record 
    9    !!                  !  96-04  (G. Madec)  introduction of dynspg 
    10    !!                  !  96-04  (M.A. Foujols)  introduction of passive tracer 
    11    !!             8.0  !  97-06  (G. Madec)  new architecture of call 
    12    !!             8.2  !  97-06  (G. Madec, M. Imbard, G. Roullet)  free surface 
    13    !!             8.2  !  99-02  (G. Madec, N. Grima)  hpg implicit 
    14    !!             8.2  !  00-07  (J-M Molines, M. Imbard)  Open Bondary Conditions 
    15    !!             9.0  !  02-06  (G. Madec)  free form, suppress macro-tasking 
    16    !!             " "  !  04-08  (C. Talandier) New trends organization 
    17    !!             " "  !  05-01  (C. Ethe) Add the KPP closure scheme 
    18    !!             " "  !  05-11  (V. Garnier) Surface pressure gradient organization 
    19    !!             " "  !  05-11  (G. Madec)  Reorganisation of tra and dyn calls 
    20    !!             " "  !  06-01  (L. Debreu, C. Mazauric)  Agrif implementation 
    21    !!             " "  !  06-07  (S. Masson)  restart using iom 
     6   !! History :        !  1991-03  ()  Original code 
     7   !!                  !  1991-11  (G. Madec) 
     8   !!                  !  1992-06  (M. Imbard)  add a first output record 
     9   !!                  !  1996-04  (G. Madec)  introduction of dynspg 
     10   !!                  !  1996-04  (M.A. Foujols)  introduction of passive tracer 
     11   !!             8.0  !  1997-06  (G. Madec)  new architecture of call 
     12   !!             8.2  !  1997-06  (G. Madec, M. Imbard, G. Roullet)  free surface 
     13   !!             8.2  !  1999-02  (G. Madec, N. Grima)  hpg implicit 
     14   !!             8.2  !  2000-07  (J-M Molines, M. Imbard)  Open Bondary Conditions 
     15   !!   NEMO      1.0  !  2002-06  (G. Madec)  free form, suppress macro-tasking 
     16   !!              -   !  2004-08  (C. Talandier) New trends organization 
     17   !!              -   !  2005-01  (C. Ethe) Add the KPP closure scheme 
     18   !!              -   !  2005-11  (V. Garnier) Surface pressure gradient organization 
     19   !!              -   !  2005-11  (G. Madec)  Reorganisation of tra and dyn calls 
     20   !!             2.0  !  2006-01  (L. Debreu, C. Mazauric)  Agrif implementation 
     21   !!              -   !  2006-07  (S. Masson)  restart using iom 
     22   !!             2.4  !  2008-01  (G. Madec) Merge TRA-TRC 
    2223   !!---------------------------------------------------------------------- 
    2324   !!   stp            : OPA system time-stepping 
    … …  
    323324      IF( lk_trabbl_adv  )   CALL tra_bbl_adv( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 
    324325 
    325       IF( lk_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
     326      IF( lk_tradmp      )   THEN                           ! internal damping trends 
     327                             CALL tra_dmp    ( kstp, 'TRA', jp_tem, tb, ta )      ! temperature 
     328                             CALL tra_dmp    ( kstp, 'TRA', jp_sal, sb, sa )      ! salinity 
     329      ENDIF 
    326330 
    327331                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 

  • branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r777 r790  
    2828   !!---------------------------------------------------------------------- 
    2929   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    30    !! $Id:$  
     30   !! $Id$  
    3131   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3232   !!---------------------------------------------------------------------- 
    … …  
    9090# endif 
    9191# if defined key_trc_diaadd 
     92!!gm  bug introduced: no more mask below jpkb !  
    9293               trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 
    9394# endif 
    … …  
    9798 
    9899#if defined key_trc_diabio 
    99       CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. )    ! Lateral boundary conditions on trcbio 
     100      CALL lbc_lnk( trbio(:,:,1,8), 'T', 1. )    ! Lateral boundary conditions on trcbio 
    100101#endif 
    101102#if defined key_trc_diaadd 
Note: See TracChangeset for help on using the changeset viewer.