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 503 – NEMO

Changeset 503


Ignore:
Timestamp:
2006-09-27T10:52:29+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_064 : CT : general trends update including the addition of mean windows analysis possibility in the mixed layer

Location:
trunk/NEMO/OPA_SRC
Files:
2 added
42 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/DYN/dynhpg.F90

    r474 r503  
    44   !! Ocean dynamics:  hydrostatic pressure gradient trend 
    55   !!====================================================================== 
     6   !! History :  1.0  !  87-09  (P. Andrich, M.-A. Foujols)  hpg_zco: Original code 
     7   !!            5.0  !  91-11  (G. Madec) 
     8   !!            7.0  !  96-01  (G. Madec)  hpg_sco: Original code for s-coordinates 
     9   !!            8.0  !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg 
     10   !!            8.5  !  02-07  (G. Madec)  F90: Free form and module 
     11   !!            8.5  !  02-08  (A. Bozec)  hpg_zps: Original code 
     12   !!            9.0  !  05-10  (A. Beckmann, B.W. An)  various s-coordinate options 
     13   !!                           Original code for hpg_ctl, hpg_hel hpg_wdj, hpg_djc, hpg_rot  
     14   !!            9.0  !  05-11  (G. Madec) style & small optimisation 
     15   !!---------------------------------------------------------------------- 
    616 
    717   !!---------------------------------------------------------------------- 
    … …  
    1828   !!       hpg_rot  : s-coordinate (ROTated axes scheme) 
    1929   !!---------------------------------------------------------------------- 
    20    !! * Modules used 
    2130   USE oce             ! ocean dynamics and tracers 
    2231   USE dom_oce         ! ocean space and time domain 
    … …  
    3241   PRIVATE 
    3342 
    34    !! * Accessibility 
    35    PUBLIC dyn_hpg                ! routine called by step.F90 
     43   PUBLIC   dyn_hpg    ! routine called by step module 
    3644 
    3745#if defined key_mpp_omp 
    … …  
    4957#endif 
    5058 
    51    !! * Share module variables 
    52    LOGICAL  ::               & !!! ** nam_dynhpg **   hpg flags 
    53       ln_hpg_zco = .TRUE. ,  &  ! z-coordinate - full steps 
    54       ln_hpg_zps = .FALSE.,  &  ! z-coordinate - partial steps (interpolation) 
    55       ln_hpg_sco = .FALSE.,  &  ! s-coordinate (standard jacobian formulation) 
    56       ln_hpg_hel = .FALSE.,  &  ! s-coordinate (helsinki modification) 
    57       ln_hpg_wdj = .FALSE.,  &  ! s-coordinate (weighted density jacobian) 
    58       ln_hpg_djc = .FALSE.,  &  ! s-coordinate (Density Jacobian with Cubic polynomial) 
    59       ln_hpg_rot = .FALSE.      ! s-coordinate (ROTated axes scheme) 
    60  
    61    REAL(wp) ::               & !!! ** nam_dynhpg **  
    62       gamm = 0.e0               ! weighting coefficient 
    63  
    64    INTEGER  ::               &  !  
    65       nhpg  =  0                 ! = 0 to 6, type of pressure gradient scheme used 
    66       !                         ! (deduced from ln_hpg_... flags) 
     59   !!* Namelist nam_dynhpg : Choice of horizontal pressure gradient computation 
     60   LOGICAL  ::   ln_hpg_zco = .TRUE.    ! z-coordinate - full steps 
     61   LOGICAL  ::   ln_hpg_zps = .FALSE.   ! z-coordinate - partial steps (interpolation) 
     62   LOGICAL  ::   ln_hpg_sco = .FALSE.   ! s-coordinate (standard jacobian formulation) 
     63   LOGICAL  ::   ln_hpg_hel = .FALSE.   ! s-coordinate (helsinki modification) 
     64   LOGICAL  ::   ln_hpg_wdj = .FALSE.   ! s-coordinate (weighted density jacobian) 
     65   LOGICAL  ::   ln_hpg_djc = .FALSE.   ! s-coordinate (Density Jacobian with Cubic polynomial) 
     66   LOGICAL  ::   ln_hpg_rot = .FALSE.   ! s-coordinate (ROTated axes scheme) 
     67   REAL(wp) ::   gamm       = 0.e0      ! weighting coefficient 
     68   NAMELIST/nam_dynhpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, ln_hpg_hel,   & 
     69      &                 ln_hpg_wdj, ln_hpg_djc, ln_hpg_rot, gamm 
     70 
     71   INTEGER  ::   nhpg  =  0             ! = 0 to 6, type of pressure gradient scheme used 
     72      !                                 ! (deduced from ln_hpg_... flags) 
    6773 
    6874   !! * Substitutions 
    … …  
    7278   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    7379   !! $Header$  
    74    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     80   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    7581   !!---------------------------------------------------------------------- 
    7682 
    … …  
    8288      !! 
    8389      !! ** Method  :   Call the hydrostatic pressure gradient routine  
    84       !!      using the scheme defined in the namelist (nhpg parameter) 
     90      !!              using the scheme defined in the namelist 
    8591      !!    
    8692      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    8793      !!             - Save the trend (l_trddyn=T) 
    88       !!             - Control print  (ln_ctl) 
    89       !! 
    90       !! History : 
    91       !!   9.0  !  05-10  (A. Beckmann, G. Madec) various s-coordinate options 
    92       !!---------------------------------------------------------------------- 
    93       !! * Arguments 
    94       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    95  
    96       !! * local declarations 
    97       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    98          ztrdu, ztrdv                         ! 3D temporary workspace 
     94      !!---------------------------------------------------------------------- 
     95      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     96      !! 
     97      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D temporary workspace 
    9998      !!---------------------------------------------------------------------- 
    10099    
    101100      IF( kt == nit000 )   CALL hpg_ctl      ! initialisation & control of options 
    102101 
    103       ! Temporary saving of ua and va trends (l_trddyn) 
    104       IF( l_trddyn )   THEN 
     102      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
    105103         ztrdu(:,:,:) = ua(:,:,:)   
    106104         ztrdv(:,:,:) = va(:,:,:)  
    … …  
    108106 
    109107      SELECT CASE ( nhpg )      ! Hydrastatic pressure gradient computation 
    110       CASE ( 0 )                  ! z-coordinate  
    111          CALL hpg_zco( kt ) 
    112       CASE ( 1 )                  ! z-coordinate plus partial steps (interpolation) 
    113          CALL hpg_zps( kt ) 
    114       CASE ( 2 )                  ! s-coordinate (standard jacobian formulation) 
    115          CALL hpg_sco( kt ) 
    116       CASE ( 3 )                  ! s-coordinate (helsinki modification) 
    117          CALL hpg_hel( kt ) 
    118       CASE ( 4 )                  ! s-coordinate (weighted density jacobian) 
    119          CALL hpg_wdj( kt ) 
    120       CASE ( 5 )                  ! s-coordinate (Density Jacobian with Cubic polynomial) 
    121          CALL hpg_djc( kt ) 
    122       CASE ( 6 )                  ! s-coordinate (ROTated axes scheme) 
    123          CALL hpg_rot( kt ) 
    124       CASE ( 10 )                  ! z-coordinate 
    125          CALL hpg_zco_jki( kt ) 
    126       CASE ( 11 )                  ! z-coordinate plus partial steps (interpolation) 
    127          CALL hpg_zps_jki( kt ) 
    128       CASE ( 12 )                  ! s-coordinate (standard jacobian formulation) 
    129          CALL hpg_sco_jki( kt ) 
     108      CASE (  0 )   ;   CALL hpg_zco    ( kt )      ! z-coordinate 
     109      CASE (  1 )   ;   CALL hpg_zps    ( kt )      ! z-coordinate plus partial steps (interpolation) 
     110      CASE (  2 )   ;   CALL hpg_sco    ( kt )      ! s-coordinate (standard jacobian formulation) 
     111      CASE (  3 )   ;   CALL hpg_hel    ( kt )      ! s-coordinate (helsinki modification) 
     112      CASE (  4 )   ;   CALL hpg_wdj    ( kt )      ! s-coordinate (weighted density jacobian) 
     113      CASE (  5 )   ;   CALL hpg_djc    ( kt )      ! s-coordinate (Density Jacobian with Cubic polynomial) 
     114      CASE (  6 )   ;   CALL hpg_rot    ( kt )      ! s-coordinate (ROTated axes scheme) 
     115      CASE ( 10 )   ;   CALL hpg_zco_jki( kt )      ! z-coordinate (k-j-i) 
     116      CASE ( 11 )   ;   CALL hpg_zps_jki( kt )      ! z-coordinate plus partial steps (interpolation) (k-j-i) 
     117      CASE ( 12 )   ;   CALL hpg_sco_jki( kt )      ! s-coordinate (standard jacobian formulation) (k-j-i) 
    130118      END SELECT 
    131119 
    132       ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 
    133       IF( l_trddyn )   THEN 
     120      IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 
    134121         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    135122         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    136          CALL trd_mod( ztrdu, ztrdv, jpdtdhpg, 'DYN', kt ) 
     123         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_hpg, 'DYN', kt ) 
    137124      ENDIF           
    138        
    139       IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    140          CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask, & 
    141             &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    142       ENDIF 
    143        
     125      ! 
     126      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   & 
     127         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     128      ! 
    144129   END SUBROUTINE dyn_hpg 
    145130 
    … …  
    154139      !! ** Action  :   Read the namelist namdynhpg and check the consistency 
    155140      !!      with the type of vertical coordinate used (zco, zps, sco) 
    156       !! 
    157       !! History : 
    158       !!   9.0  !  05-10  (A. Beckmann)  Original code 
    159141      !!---------------------------------------------------------------------- 
    160142      INTEGER ::   ioptio = 0      ! temporary integer 
    161  
    162       NAMELIST/nam_dynhpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,               & 
    163          &                 ln_hpg_hel, ln_hpg_wdj, ln_hpg_djc, ln_hpg_rot,   & 
    164          &                 gamm 
    165       !!---------------------------------------------------------------------- 
    166  
    167       ! Read Namelist nam_dynhpg : pressure gradient calculation options 
    168       REWIND ( numnam ) 
     143      !!---------------------------------------------------------------------- 
     144 
     145      REWIND ( numnam )               ! Read Namelist nam_dynhpg : pressure gradient calculation options 
    169146      READ   ( numnam, nam_dynhpg ) 
    170147 
    171       ! Control print 
    172       IF(lwp) THEN 
     148      IF(lwp) THEN                    ! Control print 
    173149         WRITE(numout,*) 
    174150         WRITE(numout,*) 'dyn:hpg_ctl : hydrostatic pressure gradient control' 
    … …  
    185161      ENDIF 
    186162 
    187       ! set nhpg from ln_hpg_... flags 
     163      !                               ! Set nhpg from ln_hpg_... flags 
    188164      IF( ln_hpg_zco )   nhpg = 0 
    189165      IF( ln_hpg_zps )   nhpg = 1 
    … …  
    194170      IF( ln_hpg_rot )   nhpg = 6 
    195171 
    196       ! Consitency check 
     172      !                               ! Consitency check 
    197173      ioptio = 0  
    198174      IF( ln_hpg_zco )   ioptio = ioptio + 1 
    … …  
    203179      IF( ln_hpg_djc )   ioptio = ioptio + 1 
    204180      IF( ln_hpg_rot )   ioptio = ioptio + 1 
    205       IF ( ioptio > 1 )   & 
    206            &   CALL ctl_stop( ' several hydrostatic pressure gradient options used' ) 
     181      IF ( ioptio /= 1 )   CALL ctl_stop( ' NO or several hydrostatic pressure gradient options used' ) 
    207182 
    208183      IF( lk_dynhpg_jki ) THEN 
    … …  
    211186         IF(lwp) WRITE(numout,*) '          Autotasking or OPENMP: use j-k-i loops (i.e. _jki routines)' 
    212187      ENDIF 
    213  
     188      ! 
    214189   END SUBROUTINE hpg_ctl 
    215190 
    … …  
    230205      !!  
    231206      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    232       !! 
    233       !! History : 
    234       !!   1.0  !  87-09  (P. Andrich, M.-A. Foujols)  Original code 
    235       !!   5.0  !  91-11  (G. Madec) 
    236       !!   7.0  !  96-01  (G. Madec) 
    237       !!   8.0  !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg 
    238       !!   8.5  !  02-07  (G. Madec)  F90: Free form and module 
    239       !!---------------------------------------------------------------------- 
    240       !! * modules used 
    241       USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace 
    242          &              zhpj => sa      ! use sa as 3D workspace 
    243        
    244       !! * Arguments 
    245       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    246        
    247       !! * local declarations 
    248       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    249       REAL(wp) ::   &    
    250          zcoef0, zcoef1                 ! temporary scalars 
     207      !!---------------------------------------------------------------------- 
     208      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     209      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     210      !! 
     211      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     212      !! 
     213      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
     214      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
    251215      !!---------------------------------------------------------------------- 
    252216       
    … …  
    257221      ENDIF 
    258222       
    259        
    260223      ! Local constant initialization  
    261       ! ----------------------------- 
    262224      zcoef0 = - grav * 0.5 
    263225 
    264226      ! Surface value 
    265       ! ------------- 
    266227      DO jj = 2, jpjm1 
    267228         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    275236         END DO 
    276237      END DO 
    277  
     238      ! 
    278239      ! interior value (2=<jk=<jpkm1) 
    279       ! -------------- 
    280240      DO jk = 2, jpkm1 
    281241         DO jj = 2, jpjm1 
    … …  
    296256         END DO 
    297257      END DO 
    298  
     258      ! 
    299259   END SUBROUTINE hpg_zco 
    300260 
    … …  
    307267      !!  
    308268      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend 
    309       !!     
    310       !! History : 
    311       !!   8.5  !  02-08  (A. Bozec)  Original code 
    312       !!   9.0  !  04-08  (G. Madec)  F90 
    313269      !!----------------------------------------------------------------------  
    314       !! * modules used                                  
    315       USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace 
    316          &              zhpj => sa      ! use sa as 3D workspace 
    317                 
    318       !! * Arguments 
    319       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    320  
    321       !! * local declarations 
    322       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    323       INTEGER ::   iku, ikv             ! temporary integers 
    324       REAL(wp) ::   & 
    325          zcoef0, zcoef1,             &  ! temporary scalars 
    326          zcoef2, zcoef3                 !    "         " 
     270      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     271      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     272      !! 
     273      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     274      !! 
     275      INTEGER  ::   ji, jj, jk                       ! dummy loop indices 
     276      INTEGER  ::   iku, ikv                         ! temporary integers 
     277      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars 
    327278      !!---------------------------------------------------------------------- 
    328279 
    … …  
    330281         IF(lwp) WRITE(numout,*) 
    331282         IF(lwp) WRITE(numout,*) 'dyn:hpg_zps : hydrostatic pressure gradient trend' 
    332          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps' 
    333          IF(lwp) WRITE(numout,*) '              vector optimization' 
     283         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization' 
    334284      ENDIF 
    335285 
    336  
    337       ! 0. Local constant initialization 
    338       ! -------------------------------- 
     286      ! Local constant initialization 
    339287      zcoef0 = - grav * 0.5 
    340288 
    341       ! 1. Surface value 
    342       ! ---------------- 
     289      !  Surface value 
    343290      DO jj = 2, jpjm1 
    344291         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    353300      END DO 
    354301 
    355       ! 2. interior value (2=<jk=<jpkm1) 
    356       ! ----------------- 
     302      ! interior value (2=<jk=<jpkm1) 
    357303      DO jk = 2, jpkm1 
    358304         DO jj = 2, jpjm1 
    … …  
    410356# endif 
    411357      END DO 
    412  
     358      ! 
    413359   END SUBROUTINE hpg_zps 
    414360 
    … …  
    431377      !! 
    432378      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    433       !! 
    434       !! History : 
    435       !!   7.0  !  96-01  (G. Madec)  s-coordinates 
    436       !!        !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg 
    437       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module, vector opt. 
    438       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    439       !!   9.0  !  05-10  (A. Beckmann) various s-coordinate options 
    440       !!---------------------------------------------------------------------- 
    441       !! * modules used 
    442       USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace 
    443          &              zhpj => sa      ! use sa as 3D workspace 
    444  
    445       !! * Arguments 
    446       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    447  
    448       !! * Local declarations 
    449       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    450       REAL(wp) ::   & 
    451          zcoef0, zuap, zvap             ! temporary scalars 
     379      !!---------------------------------------------------------------------- 
     380      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     381      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     382      !! 
     383      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     384      !! 
     385      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     386      REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
    452387      !!---------------------------------------------------------------------- 
    453388 
    … …  
    458393      ENDIF 
    459394 
    460  
    461       ! 0. Local constant initialization 
    462       ! -------------------------------- 
     395      ! Local constant initialization 
    463396      zcoef0 = - grav * 0.5 
    464397 
    465  
    466       ! 1. Surface value 
    467       ! ----------------                           
     398      ! Surface value 
    468399      DO jj = 2, jpjm1 
    469400         DO ji = fs_2, fs_jpim1   ! vector opt.    
    … …  
    484415      END DO    
    485416             
    486                 
    487       ! 2. interior value (2=<jk=<jpkm1) 
    488       ! -----------------      
     417      ! interior value (2=<jk=<jpkm1) 
    489418      DO jk = 2, jpkm1                                   
    490419         DO jj = 2, jpjm1      
    … …  
    508437         END DO 
    509438      END DO 
    510  
     439      ! 
    511440   END SUBROUTINE hpg_sco 
    512441 
    … …  
    530459      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    531460      !!             - Save the trend (l_trddyn=T) 
    532       !! 
    533       !! History : 
    534       !!   9.0  !  05-10  (A. Beckmann)  Original code 
    535       !!---------------------------------------------------------------------- 
    536       !! * modules used 
    537       USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace 
    538          &              zhpj => sa      ! use sa as 3D workspace 
    539  
    540       !! * Arguments 
    541       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    542        
    543       !! * Local declarations 
    544       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    545       REAL(wp) ::   & 
    546          zcoef0, zuap, zvap             ! temporary scalars 
     461      !!---------------------------------------------------------------------- 
     462      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     463      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     464      !! 
     465      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     466      !! 
     467      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     468      REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
    547469      !!---------------------------------------------------------------------- 
    548470 
    … …  
    553475      ENDIF 
    554476 
    555  
    556       ! 0. Local constant initialization 
    557       ! -------------------------------- 
     477      ! Local constant initialization 
    558478      zcoef0 = - grav * 0.5 
    559  
    560479  
    561       ! 1. Surface value 
    562       ! ---------------- 
     480      ! Surface value 
    563481      DO jj = 2, jpjm1 
    564482         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    578496         END DO 
    579497      END DO 
    580  
    581       ! 2. interior value (2=<jk=<jpkm1) 
    582       ! ----------------- 
     498      ! 
     499      ! interior value (2=<jk=<jpkm1) 
    583500      DO jk = 2, jpkm1 
    584501         DO jj = 2, jpjm1 
    … …  
    606523         END DO 
    607524      END DO 
    608  
     525      ! 
    609526   END SUBROUTINE hpg_hel 
    610527 
    … …  
    619536      !! 
    620537      !! Reference : Song, Mon. Wea. Rev., 126, 3213-3230, 1998. 
    621       !! 
    622       !! History : 
    623       !!   9.0  !  05-05  (B.W. An)  Original code 
    624       !!        !  05-10  (G. Madec) style & small optimisation 
    625       !!---------------------------------------------------------------------- 
    626       !! * modules used 
    627       USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace 
    628          &              zhpj => sa      ! use sa as 3D workspace 
    629  
    630       !! * Arguments 
    631       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    632  
    633       !! * Local declarations 
    634       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    635       REAL(wp) ::   & 
    636          zcoef0, zuap, zvap,         &  ! temporary scalars 
    637          zalph , zbeta                  !    "         " 
     538      !!---------------------------------------------------------------------- 
     539      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     540      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     541      !! 
     542      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     543      !! 
     544      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     545      REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
     546      REAL(wp) ::   zalph , zbeta        !    "         " 
    638547      !!---------------------------------------------------------------------- 
    639548 
    … …  
    644553      ENDIF 
    645554 
    646  
    647555      ! Local constant initialization 
    648       ! ----------------------------- 
    649556      zcoef0 = - grav * 0.5 
    650557      zalph  = 0.5 - gamm        ! weighting coefficients (alpha=0.5-gamm) 
    … …  
    652559 
    653560      ! Surface value (no ponderation) 
    654       ! ------------- 
    655561      DO jj = 2, jpjm1 
    656562         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    672578 
    673579      ! Interior value (2=<jk=<jpkm1) (weighted with zalph & zbeta) 
    674       ! -------------- 
    675580      DO jk = 2, jpkm1 
    676581         DO jj = 2, jpjm1 
    … …  
    700605         END DO 
    701606      END DO 
    702  
     607      ! 
    703608   END SUBROUTINE hpg_wdj 
    704609 
    … …  
    710615      !! ** Method  :   Density Jacobian with Cubic polynomial scheme 
    711616      !!  
    712       !! Reference: Shchepetkin, A.F. & J.C. McWilliams, J. Geophys. Res., 
    713       !!            108(C3), 3090, 2003 
    714       !! History : 
    715       !!   9.0  !  05-05  (B.W. An)  Original code 
    716       !!---------------------------------------------------------------------- 
    717       !! * modules used 
    718       USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace 
    719          &              zhpj => sa      ! use sa as 3D workspace 
    720  
    721       !! * Arguments 
    722       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    723        
    724       !! * Local declarations 
    725       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    726       REAL(wp) ::   & 
    727          zcoef0, z1_10, cffu, cffx,  &  ! temporary scalars 
    728                  z1_12, cffv, cffy,  &  !    "         " 
    729          zep   , cffw                   !    "         " 
    730       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &  ! 3D workspace 
    731          drhox, dzx, drhou, dzu, rho_i,     & 
    732          drhoy, dzy, drhov, dzv, rho_j,     & 
    733          drhoz, dzz, drhow, dzw, rho_k 
     617      !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003 
     618      !!---------------------------------------------------------------------- 
     619      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     620      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     621      !! 
     622      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     623      !! 
     624      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     625      REAL(wp) ::   zcoef0, zep, cffw   ! temporary scalars 
     626      REAL(wp) ::   z1_10, cffu, cffx   !    "         " 
     627      REAL(wp) ::   z1_12, cffv, cffy   !    "         " 
     628      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhox, dzx, drhou, dzu, rho_i   ! 3D workspace 
     629      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhoy, dzy, drhov, dzv, rho_j   !  "      " 
     630      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhoz, dzz, drhow, dzw, rho_k   !  "      " 
    734631      !!---------------------------------------------------------------------- 
    735632 
    … …  
    741638 
    742639 
    743       ! 0. Local constant initialization 
    744       ! -------------------------------- 
     640      ! Local constant initialization 
    745641      zcoef0 = - grav * 0.5 
    746642      z1_10  = 1.0 / 10.0 
    … …  
    771667      zep = 1.e-15 
    772668 
    773       !!bug  gm  drhoz not defined at level 1 and used (jk-1 with jk=2) 
    774       !!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj 
     669!!bug  gm  drhoz not defined at level 1 and used (jk-1 with jk=2) 
     670!!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj 
    775671 
    776672      DO jk = 2, jpkm1 
    … …  
    930826         END DO 
    931827      END DO 
    932  
     828      ! 
    933829   END SUBROUTINE hpg_djc 
    934830 
    … …  
    941837      !! 
    942838      !! Reference: Thiem & Berntsen, Ocean Modelling, In press, 2005. 
    943       !! History : 
    944       !!   9.0  !  05-07 (B.W. An) 
    945       !!   9.0  !  05-10 (A. Beckmann) adapted to non-equidistant and masked grids 
    946       !!---------------------------------------------------------------------- 
    947       !! * modules used 
    948       USE oce, ONLY :   zhpi => ta,         &  ! use ta as 3D workspace 
    949          &              zhpj => sa             ! use sa as 3D workspace 
    950  
    951       !! * Arguments 
    952       INTEGER, INTENT( in ) ::   kt            ! ocean time-step index 
    953        
    954       !! * Local declarations 
    955       INTEGER ::   ji, jj, jk                  ! dummy loop indices 
    956       REAL(wp) ::   & 
    957          zforg, zcoef0, zuap, zmskd1, zmskd1m,                             & 
    958          zfrot        , zvap, zmskd2, zmskd2m 
    959       REAL(wp), DIMENSION(jpi,jpj) ::       &  ! 2D temporary workspace 
    960          zdistr, zsina, zcosa              
    961       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &  ! 3D temporary workspace 
    962          zhpiorg, zhpirot, zhpitra, zhpine, &  
    963          zhpjorg, zhpjrot, zhpjtra, zhpjne 
     839      !!---------------------------------------------------------------------- 
     840      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     841      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     842      !! 
     843      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     844      !! 
     845      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     846      REAL(wp) ::   zforg, zcoef0, zuap, zmskd1, zmskd1m   ! temporary scalar 
     847      REAL(wp) ::   zfrot        , zvap, zmskd2, zmskd2m   !    "         " 
     848      REAL(wp), DIMENSION(jpi,jpj)     ::   zdistr, zsina, zcosa                ! 2D workspace 
     849      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpiorg, zhpirot, zhpitra, zhpine   ! 3D workspace 
     850      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpjorg, zhpjrot, zhpjtra, zhpjne   !  "      " 
    964851      !!---------------------------------------------------------------------- 
    965852 
    … …  
    11181005         END DO 
    11191006      END DO 
    1120  
     1007      ! 
    11211008   END SUBROUTINE hpg_rot 
    11221009 

  • trunk/NEMO/OPA_SRC/DYN/dynhpg_jki.F90

    r456 r503  
    44   !! Ocean dynamics:  hydrostatic pressure gradient trend 
    55   !!====================================================================== 
    6  
    7    !!---------------------------------------------------------------------- 
    8    !!   hpg...o_jki : update the momentum trend with the horizontal 
    9    !!                  gradient of the hydrostatic pressure 
    10    !!---------------------------------------------------------------------- 
    11    !! * Modules used 
     6   !! History :  9.0  !  06-09  (G. Madec) From dynhpg module 
     7   !!---------------------------------------------------------------------- 
     8 
     9   !!---------------------------------------------------------------------- 
     10   !!   hpg_sco_jki : update the momentum trend with the horizontal 
     11   !!                 gradient of the hydrostatic pressure (s-coordinate) 
     12   !!   hpg_zps_jki : update the momentum trend with the horizontal 
     13   !!                 gradient of the hydrostatic pressure (partial step) 
     14   !!   hpg_zco_jki : update the momentum trend with the horizontal 
     15   !!                 gradient of the hydrostatic pressure (z-coordinate) 
     16   !!---------------------------------------------------------------------- 
    1217   USE oce             ! ocean dynamics and tracers 
    1318   USE dom_oce         ! ocean space and time domain 
    1419   USE phycst          ! physical constants 
    1520   USE in_out_manager  ! I/O manager 
    16    USE trdmod          ! ocean dynamics trends 
    17    USE trdmod_oce      ! ocean variables trends 
    18    USE prtctl          ! Print control 
    1921   USE lbclnk          ! lateral boundary condition 
    2022 
    … …  
    2224   PRIVATE 
    2325 
    24    !! * Accessibility 
    25    PUBLIC hpg_sco_jki ! routine called by step.F90 
    26    PUBLIC hpg_zps_jki ! routine called by step.F90 
    27    PUBLIC hpg_zco_jki ! routine called by step.F90 
     26   PUBLIC   hpg_sco_jki   ! routine called by step.F90 
     27   PUBLIC   hpg_zps_jki   ! routine called by step.F90 
     28   PUBLIC   hpg_zco_jki   ! routine called by step.F90 
    2829 
    2930   !! * Substitutions 
    … …  
    3233   !!---------------------------------------------------------------------- 
    3334   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     35   !! $Header$ 
     36   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3437   !!---------------------------------------------------------------------- 
    3538 
    … …  
    5760      !! 
    5861      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    59       !!             - Save the trend in (utrd,vtrd) ('key_trddyn') 
    60       !! 
    61       !! History : 
    62       !!   7.0  !  96-01  (G. Madec)  s-coordinates 
    63       !!        !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg 
    64       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    65       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    66       !!---------------------------------------------------------------------- 
    67       !! * modules used 
    68       USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace 
    69          &              zhpj => sa      ! use sa as 3D workspace 
    70  
    71       !! * Arguments 
    72       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    73        
    74       !! * Local declarations 
    75       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    76       REAL(wp) ::   & 
    77          zcoef0, zuap, zvap     ! temporary scalars 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    79          ztdua, ztdva                   ! temporary scalars 
     62      !!             - Save the trend in (ztrdu,ztrdv) ('key_trddyn') 
     63      !!---------------------------------------------------------------------- 
     64      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     65      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     66      !! 
     67      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     68      !! 
     69      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     70      REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
    8071      !!---------------------------------------------------------------------- 
    8172 
    … …  
    8677      ENDIF 
    8778 
    88       ! Save ua and va trends 
    89       IF( l_trddyn )   THEN 
    90          ztdua(:,:,:) = ua(:,:,:)  
    91          ztdva(:,:,:) = va(:,:,:)  
    92       ENDIF 
    93  
    94       ! 0. Local constant initialization 
    95       ! -------------------------------- 
     79      ! Local constant initialization 
    9680      zcoef0 = - grav * 0.5 
    9781      zuap   = 0.e0 
    … …  
    10185      DO jj = 2, jpjm1                                 !  Vertical slab 
    10286         !                                             ! =============== 
    103          ! 1. Surface value 
    104          ! ---------------- 
    105          DO ji = 2, jpim1 
     87         DO ji = 2, jpim1         !  Surface value 
    10688            ! hydrostatic pressure gradient along s-surfaces 
    10789            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj)   & 
    … …  
    118100            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap 
    119101         END DO   
    120  
    121          ! 2. interior value (2=<jk=<jpkm1) 
    122          ! ----------------- 
    123          DO jk = 2, jpkm1 
     102         ! 
     103         DO jk = 2, jpkm1         ! interior value (2=<jk=<jpkm1) 
    124104            DO ji = 2, jpim1 
    125105               ! hydrostatic pressure gradient along s-surfaces 
    … …  
    143123      END DO                                           !   End of slab 
    144124      !                                                ! =============== 
    145  
    146       ! save the hydrostatic pressure gradient trends for diagnostic 
    147       ! momentum trends 
    148       IF( l_trddyn )   THEN 
    149          zhpi(:,:,:) = ua(:,:,:) - ztdua(:,:,:) 
    150          zhpj(:,:,:) = va(:,:,:) - ztdva(:,:,:) 
    151          CALL trd_mod(zhpi, zhpj, jpdtdhpg, 'DYN', kt) 
    152       ENDIF 
    153  
    154       IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    155          CALL prt_ctl(tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask, & 
    156             &         tab3d_2=va, clinfo2=' Va: ', mask2=vmask, clinfo3='dyn') 
    157       ENDIF 
    158  
    159125   END SUBROUTINE hpg_sco_jki 
    160126 
    … …  
    178144      !! 
    179145      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    180       !!             - Save the trend in (utrd,vtrd) ('key_trddyn') 
    181       !! 
    182       !! History : 
    183       !!   8.5  !  02-08  (A. Bozec)  Original code 
    184       !!---------------------------------------------------------------------- 
    185       !! * modules used 
    186       USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace 
    187          &              zhpj => sa      ! use sa as 3D workspace 
    188  
    189       !! * Arguments 
    190       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    191  
    192       !! * local declarations 
    193       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    194       INTEGER ::   iku, ikv             ! temporary integers 
    195       REAL(wp) ::   & 
    196          zcoef0, zcoef1, zuap,       &  ! temporary scalars 
    197          zcoef2, zcoef3, zvap           !    "         " 
    198       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    199          ztdua, ztdva                   ! temporary scalars 
     146      !!             - Save the trend in (ztrdu,ztrdv) ('key_trddyn') 
     147      !!---------------------------------------------------------------------- 
     148      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     149      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     150      !! 
     151      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     152      !! 
     153      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     154      INTEGER  ::   iku, ikv               ! temporary integers 
     155      REAL(wp) ::   zcoef0, zcoef1, zuap   ! temporary scalars 
     156      REAL(wp) ::   zcoef2, zcoef3, zvap   !    "         " 
    200157      !!---------------------------------------------------------------------- 
    201158 
    … …  
    206163      ENDIF 
    207164 
    208       ! Save ua and va trends 
    209       IF( l_trddyn )   THEN 
    210          ztdua(:,:,:) = ua(:,:,:)  
    211          ztdva(:,:,:) = va(:,:,:)  
    212       ENDIF 
    213  
    214       ! 0. Local constant initialization 
    215       ! -------------------------------- 
     165      ! Local constant initialization 
    216166      zcoef0 = - grav * 0.5 
    217167      zuap   = 0.e0 
    … …  
    220170      DO jj = 2, jpjm1                                 !  Vertical slab 
    221171         !                                             ! =============== 
    222          ! 1. Surface value 
    223          ! ---------------- 
    224          DO ji = 2, jpim1 
     172         DO ji = 2, jpim1         ! Surface value 
    225173            zcoef1 = zcoef0 * fse3w(ji,jj,1) 
    226174            ! hydrostatic pressure gradient 
    … …  
    231179            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) 
    232180         END DO 
    233  
    234          ! 2. interior value (2=<jk=<jpkm1) 
    235          ! ----------------- 
    236          DO jk = 2, jpkm1 
     181         ! 
     182         DO jk = 2, jpkm1         ! interior value (2=<jk=<jpkm1) 
    237183            DO ji = 2, jpim1 
    238184               zcoef1 = zcoef0 * fse3w(ji,jj,jk) 
    … …  
    250196            END DO  
    251197         END DO 
    252  
     198         ! 
    253199         ! partial steps correction at the last level  (new gradient with  intgrd.F) 
    254200         DO ji = 2, jpim1 
    … …  
    281227      END DO                                           !   End of slab 
    282228      !                                                ! =============== 
    283  
    284       ! save the hydrostatic pressure gradient trends for diagnostic 
    285       ! momentum trends 
    286       IF( l_trddyn )   THEN 
    287          zhpi(:,:,:) = ua(:,:,:) - ztdua(:,:,:) 
    288          zhpj(:,:,:) = va(:,:,:) - ztdva(:,:,:) 
    289          CALL trd_mod(zhpi, zhpj, jpdtdhpg, 'DYN', kt) 
    290       ENDIF 
    291  
    292       IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    293          CALL prt_ctl(tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask, & 
    294             &         tab3d_2=va, clinfo2=' Va: ', mask2=vmask, clinfo3='dyn') 
    295       ENDIF    
    296  
    297229   END SUBROUTINE hpg_zps_jki 
    298230 
    … …  
    317249      !! 
    318250      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    319       !!             - Save the trend in (utrd,vtrd) ('key_trddyn') 
    320       !! 
    321       !! History : 
    322       !!   1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code 
    323       !!        !  91-11  (G. Madec) 
    324       !!        !  96-01  (G. Madec)  s-coordinates 
    325       !!        !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg 
    326       !!   8.5  !  02-07  (G. Madec)  F90: Free form and module 
    327       !!---------------------------------------------------------------------- 
    328       !! * modules used 
    329       USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace 
    330          &              zhpj => sa      ! use sa as 3D workspace 
    331  
    332       !! * Arguments 
    333       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    334  
    335       !! * local declarations 
    336       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    337       REAL(wp) ::   & 
    338          zcoef0, zcoef1, zuap, zvap     ! temporary scalars 
    339       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    340          ztdua, ztdva                   ! temporary scalars 
     251      !!             - Save the trend in (ztrdu,ztrdv) ('key_trddyn') 
     252      !!---------------------------------------------------------------------- 
     253      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
     254      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     255      !! 
     256      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     257      !! 
     258      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
     259      REAL(wp) ::   zcoef0, zcoef1, zuap, zvap   ! temporary scalars 
    341260      !!---------------------------------------------------------------------- 
    342261 
    … …  
    347266      ENDIF 
    348267 
    349       ! Save ua and va trends 
    350       IF( l_trddyn )   THEN 
    351          ztdua(:,:,:) = ua(:,:,:)  
    352          ztdva(:,:,:) = va(:,:,:)  
    353       ENDIF 
    354  
    355       ! 0. Local constant initialization 
    356       ! -------------------------------- 
     268      ! Local constant initialization 
    357269      zcoef0 = - grav * 0.5 
    358270      zuap   = 0.e0 
    … …  
    362274      DO jj = 2, jpjm1                                 !  Vertical slab 
    363275         !                                             ! =============== 
    364          ! 1. Surface value 
    365          ! ---------------- 
    366           
    367  
    368          DO ji = 2, jpim1 
     276         DO ji = 2, jpim1         ! Surface value 
    369277            zcoef1 = zcoef0 * fse3w(ji,jj,1) 
    370278            ! hydrostatic pressure gradient 
    … …  
    375283            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) 
    376284         END DO 
    377  
    378          ! 2. interior value (2=<jk=<jpkm1) 
    379          ! ----------------- 
    380          DO jk = 2, jpkm1 
     285         ! 
     286         DO jk = 2, jpkm1         ! interior value (2=<jk=<jpkm1) 
    381287            DO ji = 2, jpim1 
    382288               zcoef1 = zcoef0 * fse3w(ji,jj,jk) 
    … …  
    397303      END DO                                           !   End of slab 
    398304      !                                                ! =============== 
    399  
    400       ! save the hydrostatic pressure gradient trends for diagnostic 
    401       ! momentum trends 
    402       IF( l_trddyn )   THEN 
    403          zhpi(:,:,:) = ua(:,:,:) - ztdua(:,:,:) 
    404          zhpj(:,:,:) = va(:,:,:) - ztdva(:,:,:) 
    405  
    406          CALL trd_mod(zhpi, zhpj, jpdtdhpg, 'DYN', kt) 
    407       ENDIF 
    408  
    409       IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    410          CALL prt_ctl(tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask, & 
    411             &         tab3d_2=va, clinfo2=' Va: ', mask2=vmask, clinfo3='dyn') 
    412       ENDIF 
    413  
    414305   END SUBROUTINE hpg_zco_jki 
    415306 

  • trunk/NEMO/OPA_SRC/DYN/dynkeg.F90

    r258 r503  
    44   !! Ocean dynamics:  kinetic energy gradient trend 
    55   !!====================================================================== 
     6   !! History :  1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code 
     7   !!            7.0  !  97-05  (G. Madec)  Split dynber into dynkeg and dynhpg 
     8   !!            9.0  !  02-07  (G. Madec)  F90: Free form and module 
     9   !!---------------------------------------------------------------------- 
    610    
    711   !!---------------------------------------------------------------------- 
    812   !!   dyn_keg      : update the momentum trend with the horizontal tke 
    913   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1114   USE oce             ! ocean dynamics and tracers 
    1215   USE dom_oce         ! ocean space and time domain 
    … …  
    1922   PRIVATE 
    2023 
    21    !! * Accessibility 
    22    PUBLIC dyn_keg                ! routine called by step.F90 
     24   PUBLIC   dyn_keg    ! routine called by step module 
    2325    
    2426   !! * Substitutions 
    2527#  include "vectopt_loop_substitute.h90" 
    26    !!--------------------------------------------------------------------------------- 
     28   !!---------------------------------------------------------------------- 
    2729   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    2830   !! $Header$  
    29    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    30    !!--------------------------------------------------------------------------------- 
     31   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     32   !!---------------------------------------------------------------------- 
    3133 
    3234CONTAINS 
    … …  
    4042      !!      general momentum trend. 
    4143      !! 
    42       !! ** Method  :   Compute the now horizontal kinetic energy: 
     44      !! ** Method  :   Compute the now horizontal kinetic energy  
    4345      !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ] 
    4446      !!      Take its horizontal gradient and add it to the general momentum 
    … …  
    4850      !! 
    4951      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 
    50       !!             - Save the trends in (utrd,vtrd) ('key_trddyn') 
     52      !!             - save this trends (l_trddyn=T) for post-processing 
     53      !!---------------------------------------------------------------------- 
     54      USE oce, ONLY :   ztrdu => ta   ! use ta as 3D workspace    
     55      USE oce, ONLY :   ztrdv => sa   ! use sa as 3D workspace    
    5156      !! 
    52       !! History : 
    53       !!   1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code 
    54       !!   7.0  !  97-05  (G. Madec)  Split dynber into dynkeg and dynhpg 
    55       !!   9.0  !  02-07  (G. Madec)  F90: Free form and module 
    56       !!    "   !  04-08  (C. Talandier) New trends organization 
    57       !!---------------------------------------------------------------------- 
    58       !! * Modules used      
    59       USE oce, ONLY :    ztdua => ta,   & ! use ta as 3D workspace    
    60                          ztdva => sa      ! use sa as 3D workspace    
    61  
    62       !! * Arguments 
    63       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    64  
    65       !! * Local declarations 
    66       INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    67       REAL(wp) ::   zua, zva, zu, zv    ! temporary scalars 
    68       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    69          zhke                           ! temporary workspace 
     57      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     58      !! 
     59      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     60      REAL(wp) ::   zu, zv       ! temporary scalars 
     61      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhke   ! temporary 3D workspace 
    7062      !!---------------------------------------------------------------------- 
    7163 
    … …  
    7668      ENDIF 
    7769 
    78       ! Save ua and va trends 
    79       IF( l_trddyn )   THEN 
    80          ztdua(:,:,:) = ua(:,:,:)  
    81          ztdva(:,:,:) = va(:,:,:)  
     70      IF( l_trddyn ) THEN           ! Save ua and va trends 
     71         ztrdu(:,:,:) = ua(:,:,:)  
     72         ztrdv(:,:,:) = va(:,:,:)  
    8273      ENDIF 
    8374       
    … …  
    8576      DO jk = 1, jpkm1                                 ! Horizontal slab 
    8677         !                                             ! =============== 
    87          ! Horizontal kinetic energy at T-point 
    88          DO jj = 2, jpj 
     78         DO jj = 2, jpj         ! Horizontal kinetic energy at T-point 
    8979            DO ji = fs_2, jpi   ! vector opt. 
     80               zu = 0.25 * (  un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
     81                  &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)  ) 
    9082               zv = 0.25 * (  vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    91                             + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)  ) 
    92                zu = 0.25 * (  un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    93                             + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)  ) 
     83                  &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)  ) 
    9484               zhke(ji,jj,jk) = zv + zu 
    9585            END DO   
    9686         END DO   
    97           
    98          ! Horizontal gradient of Horizontal kinetic energy 
    99          DO jj = 2, jpjm1 
     87         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends 
    10088            DO ji = fs_2, fs_jpim1   ! vector opt. 
    101                ! gradient of kinetic energy 
    102                zua = -( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    103                zva = -( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
    104                ! add to the general momentum trends 
    105                ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    106                va(ji,jj,jk) = va(ji,jj,jk) + zva 
     89               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
     90               va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
    10791            END DO  
    10892         END DO 
    … …  
    11195      !                                                ! =============== 
    11296 
    113       ! save the Kinetic Energy trends for diagnostic 
    114       ! momentum trends 
    115       IF( l_trddyn )   THEN 
    116          ztdua(:,:,:) = ua(:,:,:) - ztdua(:,:,:) 
    117          ztdva(:,:,:) = va(:,:,:) - ztdva(:,:,:) 
    118  
    119          CALL trd_mod(ztdua, ztdva, jpdtdkeg, 'DYN', kt) 
     97      IF( l_trddyn ) THEN      ! save the Kinetic Energy trends for diagnostic 
     98         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     99         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     100         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_keg, 'DYN', kt ) 
    120101      ENDIF 
    121  
    122       IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    123          CALL prt_ctl(tab3d_1=ua, clinfo1=' keg  - Ua: ', mask1=umask, & 
    124             &         tab3d_2=va, clinfo2=' Va: ', mask2=vmask, clinfo3='dyn') 
    125       ENDIF 
    126  
     102      ! 
     103      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' keg  - Ua: ', mask1=umask,   & 
     104         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     105      ! 
    127106   END SUBROUTINE dyn_keg 
    128107 

  • trunk/NEMO/OPA_SRC/DYN/dynldf.F90

    r474 r503  
    44   !! Ocean physics:  lateral diffusivity trends  
    55   !!===================================================================== 
     6   !! History :  9.0  !  05-11  (G. Madec)  Original code (new step architecture) 
     7   !!---------------------------------------------------------------------- 
    68 
    79   !!---------------------------------------------------------------------- 
    … …  
    911   !!   dyn_ldf_ctl : initialization, namelist read, and parameters control 
    1012   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    12    USE oce             ! ocean dynamics and tracers 
    13    USE dom_oce         ! ocean space and time domain 
    14    USE phycst          ! physical constants 
    15    USE ldfdyn_oce      ! ocean dynamics lateral physics 
    16    USE ldfslp          ! ??? 
    17    USE dynldf_bilapg   ! lateral mixing            (dyn_ldf_bilapg routine) 
    18    USE dynldf_bilap    ! lateral mixing             (dyn_ldf_bilap routine) 
    19    USE dynldf_iso      ! lateral mixing               (dyn_ldf_iso routine) 
    20    USE dynldf_lap      ! lateral mixing               (dyn_ldf_lap routine) 
    21    USE trdmod          ! ocean dynamics and tracer trends 
    22    USE trdmod_oce      ! ocean variables trends 
    23    USE prtctl          ! Print control 
    24    USE in_out_manager  ! I/O manager 
    25    USE lib_mpp         ! distribued memory computing library 
    26    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     13   USE oce            ! ocean dynamics and tracers 
     14   USE dom_oce        ! ocean space and time domain 
     15   USE phycst         ! physical constants 
     16   USE ldfdyn_oce     ! ocean dynamics lateral physics 
     17   USE ldfslp         ! lateral mixing: slopes of mixing orientation 
     18   USE dynldf_bilapg  ! lateral mixing            (dyn_ldf_bilapg routine) 
     19   USE dynldf_bilap   ! lateral mixing            (dyn_ldf_bilap  routine) 
     20   USE dynldf_iso     ! lateral mixing            (dyn_ldf_iso    routine) 
     21   USE dynldf_lap     ! lateral mixing            (dyn_ldf_lap    routine) 
     22   USE trdmod         ! ocean dynamics and tracer trends 
     23   USE trdmod_oce     ! ocean variables trends 
     24   USE prtctl         ! Print control 
     25   USE in_out_manager ! I/O manager 
     26   USE lib_mpp        ! distribued memory computing library 
     27   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2728 
    2829   IMPLICIT NONE 
    2930   PRIVATE 
    3031 
    31    !! *  Routine accessibility 
    32    PUBLIC dyn_ldf      ! called by step.F90  
     32   PUBLIC   dyn_ldf   ! called by step module  
    3333 
    34    !! * module variables 
    35    INTEGER ::                        &  
    36       nldf = 0                         ! type of lateral diffusion used 
    37       !                                ! defined from ln_dynldf_... namlist logicals) 
     34   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals) 
    3835 
    3936   !! * Substitutions 
    … …  
    4239   !!--------------------------------------------------------------------------------- 
    4340   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    44    !!--------------------------------------------------------------------------------- 
     41   !! $Header$ 
     42   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     43   !!---------------------------------------------------------------------- 
    4544 
    4645CONTAINS 
    … …  
    5150      !!  
    5251      !! ** Purpose :   compute the lateral ocean dynamics physics. 
     52      !!---------------------------------------------------------------------- 
     53      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5354      !! 
    54       !!---------------------------------------------------------------------- 
    55       !! * Arguments 
    56       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    57  
    58       !! * local declarations 
    59       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    60          ztrdu, ztrdv                         ! 3D temporary workspace 
     55      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace 
    6156      !!---------------------------------------------------------------------- 
    6257 
    … …  
    6964 
    7065      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
     66      ! 
     67      CASE ( 0 )    ;   CALL dyn_ldf_lap    ( kt )      ! iso-level laplacian 
     68      CASE ( 1 )    ;   CALL dyn_ldf_iso    ( kt )      ! rotated laplacian (except dk[ dk[.] ] part) 
     69      CASE ( 2 )    ;   CALL dyn_ldf_bilap  ( kt )      ! iso-level bilaplacian 
     70      CASE ( 3 )    ;   CALL dyn_ldf_bilapg ( kt )      ! s-coord. horizontal bilaplacian 
     71      ! 
    7172      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    72          CALL dyn_ldf_lap    ( kt ) 
    73          IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    74             CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf0 - Ua: ', mask1=umask, & 
    75                &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    76          ENDIF 
    77          CALL dyn_ldf_iso    ( kt ) 
    78          IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    79             CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf1 - Ua: ', mask1=umask, & 
    80                &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    81          ENDIF 
    82          CALL dyn_ldf_bilap  ( kt ) 
    83          IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    84             CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask, & 
    85                &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    86          ENDIF 
    87          CALL dyn_ldf_bilapg ( kt ) 
    88          IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    89             CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask, & 
    90                &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    91          ENDIF 
    92  
    93       CASE ( 0 )                                       ! iso-level laplacian 
    94          CALL dyn_ldf_lap    ( kt ) 
    95       CASE ( 1 )                                       ! rotated laplacian (except dk[ dk[.] ] part) 
    96          CALL dyn_ldf_iso    ( kt ) 
    97       CASE ( 2 )                                       ! iso-level bilaplacian 
    98          CALL dyn_ldf_bilap  ( kt ) 
    99       CASE ( 3 )                                       ! s-coord. horizontal bilaplacian 
    100          CALL dyn_ldf_bilapg ( kt ) 
     73         ;              CALL dyn_ldf_lap    ( kt ) 
     74         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf0 - Ua: ', mask1=umask,   & 
     75            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     76         ;              CALL dyn_ldf_iso    ( kt ) 
     77         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf1 - Ua: ', mask1=umask,   & 
     78            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     79         ;              CALL dyn_ldf_bilap  ( kt ) 
     80         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask,   & 
     81            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     82         ;              CALL dyn_ldf_bilapg ( kt ) 
     83         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask,   & 
     84            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    10185      END SELECT 
    10286 
    103       !                                          ! save the horizontal diffusive trends for further diagnostics 
    104       IF( l_trddyn )   THEN 
     87      IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics 
    10588         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    10689         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    107          CALL trd_mod( ztrdu, ztrdv, jpdtdldf, 'DYN', kt ) 
     90         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_ldf, 'DYN', kt ) 
    10891      ENDIF 
    109  
    110       IF(ln_ctl) THEN                            ! print mean trends (used for debugging) 
    111          CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf  - Ua: ', mask1=umask, & 
    112             &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    113       ENDIF 
    114  
     92      !                                          ! print sum trends (used for debugging) 
     93      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf  - Ua: ', mask1=umask,   & 
     94         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     95      ! 
    11596   END SUBROUTINE dyn_ldf 
    11697 
    … …  
    121102      !!  
    122103      !! ** Purpose :   initializations of the horizontal ocean dynamics physics 
    123       !! 
    124       !! ** Method : 
    125       !! 
    126       !! History : 
    127       !!   9.0  !  05-11  (G. Madec)  Original code 
    128104      !!---------------------------------------------------------------------- 
    129       !! * Local declarations 
    130105      INTEGER ::   ioptio, ierr         ! temporary integers  
    131106      !!---------------------------------------------------------------------- 
     107     
     108      !                                   ! Namelist nam_dynldf: already read in ldfdyn module 
    132109 
    133       !  Define the lateral dynamics physics parameters 
    134       ! ============================================= 
    135      
    136       ! Namelist nam_dynldf already read in ldfdyn module 
    137  
    138       IF(lwp) THEN 
     110      IF(lwp) THEN                        ! Namelist print 
    139111         WRITE(numout,*) 
    140          WRITE(numout,*) 'dyn:ldf_ctl : Choice of the lateral diffusive operator on dynamics' 
     112         WRITE(numout,*) 'dyn_ldf_ctl : Choice of the lateral diffusive operator on dynamics' 
    141113         WRITE(numout,*) '~~~~~~~~~~~' 
    142          WRITE(numout,*) '          Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)' 
    143          WRITE(numout,*) '             laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap 
    144          WRITE(numout,*) '             bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap 
    145          WRITE(numout,*) '             iso-level                   ln_dynldf_level = ', ln_dynldf_level 
    146          WRITE(numout,*) '             horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor 
    147          WRITE(numout,*) '             iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso 
     114         WRITE(numout,*) '       Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)' 
     115         WRITE(numout,*) '          laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap 
     116         WRITE(numout,*) '          bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap 
     117         WRITE(numout,*) '          iso-level                   ln_dynldf_level = ', ln_dynldf_level 
     118         WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor 
     119         WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso 
    148120      ENDIF 
    149121 
    150       ! control the consistency 
     122      !                                   ! control the consistency 
    151123      ioptio = 0 
    152124      IF( ln_dynldf_lap   )   ioptio = ioptio + 1 
    … …  
    159131      IF( ioptio /= 1 ) CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
    160132 
    161       ! defined the type of lateral diffusion from ln_dynldf_... logicals 
     133      !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals 
    162134      ierr = 0 
    163135      IF ( ln_dynldf_lap ) THEN      ! laplacian operator 
    … …  
    196168         ENDIF 
    197169      ENDIF 
     170       
     171      IF( lk_esopa )                 nldf = -1     ! esopa test 
    198172 
    199       IF( ierr == 1 )   & 
    200            &   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    201       IF( ierr == 2 )   & 
    202            &   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
     173      IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-coordinate - partial step, not allowed' ) 
     174      IF( ierr == 2 )   CALL ctl_stop( 'isoneutral bilaplacian operator does not exist' ) 
    203175      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    204          IF( .NOT.lk_ldfslp )   & 
    205            &   CALL ctl_stop(  '          the rotation of the diffusive tensor require key_ldfslp' ) 
    206       ENDIF 
    207  
    208       IF( lk_esopa ) THEN 
    209          IF(lwp ) WRITE(numout,*) '          esopa test: use all lateral physics options' 
    210          nldf = -1 
     176         IF( .NOT.lk_ldfslp )   CALL ctl_stop( 'the rotation of the diffusive tensor require key_ldfslp' ) 
    211177      ENDIF 
    212178 
    … …  
    219185         IF( nldf ==  3 )   WRITE(numout,*) '              Rotated bilaplacian' 
    220186      ENDIF 
    221  
     187      ! 
    222188   END SUBROUTINE dyn_ldf_ctl 
    223189 

  • trunk/NEMO/OPA_SRC/DYN/dynspg.F90

    r474 r503  
    44   !! Ocean dynamics:  surface pressure gradient control 
    55   !!====================================================================== 
     6   !! History :  9.0  !  05-12  (C. Talandier, G. Madec)  Original code 
     7   !!            9.0  !  05-12  (V. Garnier)  dyn_spg_ctl: Original code 
     8   !!---------------------------------------------------------------------- 
    69 
    710   !!---------------------------------------------------------------------- 
    … …  
    912   !!   dyn_spg_ctl : initialization, namelist read, and parameters control 
    1013   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1214   USE oce            ! ocean dynamics and tracers variables 
    1315   USE dom_oce        ! ocean space and time domain variables 
    … …  
    2931   PRIVATE 
    3032 
    31    !! * Accessibility 
    3233   PUBLIC dyn_spg         ! routine called by step module 
    3334 
    3435   !! * module variables 
    35    INTEGER ::                        & 
    36       nspg = 0                         ! type of surface pressure gradient scheme 
    37       !                                ! defined from lk_dynspg_...  
     36   INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_...  
    3837 
    3938   !! * Substitutions 
    … …  
    4342   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    4443   !! $Header$  
    45    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     44   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4645   !!---------------------------------------------------------------------- 
    4746 
    … …  
    5352      !! 
    5453      !! ** Purpose :   compute the lateral ocean dynamics physics. 
    55       !! 
    56       !! History : 
    57       !!   9.0  !  05-12  (C. Talandier, G. Madec)  Original code 
    58       !!---------------------------------------------------------------------- 
    59       !! * Arguments 
     54      !!---------------------------------------------------------------------- 
    6055      INTEGER, INTENT( in  ) ::   kt     ! ocean time-step index 
    6156      INTEGER, INTENT( out ) ::   kindic ! solver flag 
    62  
    63       !! * local declarations 
     57      !! 
    6458      REAL(wp) ::   z2dt                      ! temporary scalar 
    65       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    66          ztrdu, ztrdv                         ! 3D temporary workspace 
     59      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace 
    6760      !!---------------------------------------------------------------------- 
    6861 
    … …  
    7568 
    7669      SELECT CASE ( nspg )                       ! compute surf. pressure gradient trend and add it to the general trend 
     70      !                                                      ! k-j-i loops 
     71      CASE (  0 )   ;   CALL dyn_spg_exp    ( kt )              ! explicit 
     72      CASE (  1 )   ;   CALL dyn_spg_ts     ( kt )              ! time-splitting 
     73      CASE (  2 )   ;   CALL dyn_spg_flt    ( kt, kindic )      ! filtered 
     74      CASE (  3 )   ;   CALL dyn_spg_rl     ( kt, kindic )      ! rigid lid 
     75      !                                                      ! j-k-i loops 
     76      CASE ( 10 )   ;   CALL dyn_spg_exp_jki( kt )              ! explicit with j-k-i loop 
     77      CASE ( 11 )   ;   CALL dyn_spg_ts_jki ( kt )              ! time-splitting with j-k-i loop 
     78      CASE ( 12 )   ;   CALL dyn_spg_flt_jki( kt, kindic )      ! filtered with j-k-i loop 
     79      ! 
    7780      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    78          CALL dyn_spg_exp    ( kt ) 
    79          IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, & 
    80                &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    81          CALL dyn_spg_ts     ( kt ) 
    82          IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, & 
    83                &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    84          CALL dyn_spg_flt  ( kt, kindic ) 
    85          IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, & 
    86                &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    87          CALL dyn_spg_exp_jki( kt ) 
    88          IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg10- Ua: ', mask1=umask, & 
    89                &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    90          CALL dyn_spg_ts_jki ( kt ) 
    91          IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg12- Ua: ', mask1=umask, & 
    92                &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    93          CALL dyn_spg_flt_jki( kt, kindic ) 
    94          IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg13- Ua: ', mask1=umask, & 
    95                &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    96       CASE (  0 )                                       ! explicit 
    97          CALL dyn_spg_exp    ( kt ) 
    98       CASE (  1 )                                       ! time-splitting 
    99          CALL dyn_spg_ts     ( kt ) 
    100       CASE (  2 )                                       ! filtered 
    101          CALL dyn_spg_flt    ( kt, kindic ) 
    102       CASE (  3 )                                       ! rigid lid 
    103          CALL dyn_spg_rl     ( kt, kindic ) 
    104  
    105       CASE ( 10 )                                       ! explicit with j-k-i loop 
    106          CALL dyn_spg_exp_jki( kt ) 
    107       CASE ( 11 )                                       ! time-splitting with j-k-i loop 
    108          CALL dyn_spg_ts_jki ( kt ) 
    109       CASE ( 12 )                                       ! filtered with j-k-i loop 
    110          CALL dyn_spg_flt_jki( kt, kindic ) 
     81         ;              CALL dyn_spg_exp    ( kt ) 
     82         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, & 
     83            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     84         ;              CALL dyn_spg_ts     ( kt ) 
     85         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, & 
     86            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     87         ;              CALL dyn_spg_flt  ( kt, kindic ) 
     88         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, & 
     89            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     90         ;              CALL dyn_spg_exp_jki( kt ) 
     91         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' spg10- Ua: ', mask1=umask, & 
     92            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     93         ;              CALL dyn_spg_ts_jki ( kt ) 
     94         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' spg12- Ua: ', mask1=umask, & 
     95            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     96         ;              CALL dyn_spg_flt_jki( kt, kindic ) 
     97         ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' spg13- Ua: ', mask1=umask, & 
     98            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    11199      END SELECT 
    112  
    113       !                                          ! save the horizontal diffusive trends for further diagnostics 
    114       IF( l_trddyn )   THEN 
     100      !                     
     101      IF( l_trddyn )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    115102         SELECT CASE ( nspg ) 
    116103         CASE ( 0, 1, 3, 10, 11 ) 
    … …  
    123110            ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:) 
    124111         END SELECT 
    125          CALL trd_mod( ztrdu, ztrdv, jpdtdspg, 'DYN', kt ) 
    126       ENDIF 
    127  
     112         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_spg, 'DYN', kt ) 
     113      ENDIF 
    128114      !                                          ! print mean trends (used for debugging) 
    129115      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, & 
    130116         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    131  
     117      ! 
    132118   END SUBROUTINE dyn_spg 
    133119 
    … …  
    139125      !! ** Purpose :   Control the consistency between cpp options for  
    140126      !!      surface pressure gradient schemes 
    141       !! 
    142       !! History : 
    143       !!   9.0  !  05-10  (V. Garnier)  Original code : spg re-organization 
    144127      !!---------------------------------------------------------------------- 
    145128      !! * Local declarations 

  • trunk/NEMO/OPA_SRC/DYN/dynspg_flt_jki.F90

    r474 r503  
    99   !!   'key_mpp_omp'                              j-k-i loop (vector opt.) 
    1010   !!---------------------------------------------------------------------- 
     11   !!---------------------------------------------------------------------- 
    1112   !!   dyn_spg_flt_jki : Update the momentum trend with the surface pressure 
    1213   !!                     gradient for the free surf. constant volume case 
    1314   !!                     with auto-tasking (j-slab) (no vectior opt.) 
    1415   !!---------------------------------------------------------------------- 
    15    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    16    !! $Header$  
    17    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    18    !!---------------------------------------------------------------------- 
    19    !! * Modules used 
    2016   USE oce             ! ocean dynamics and tracers  
    2117   USE dom_oce         ! ocean space and time domain 
    … …  
    5147   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    5248   !! $Header$  
    53    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     49   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5450   !!---------------------------------------------------------------------- 
    5551 
    … …  
    10096      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend 
    10197      !! 
    102       !! References : 
    103       !!      Roullet and Madec 1999, JGR. 
    104       !! 
    105       !! History : 
    106       !!        !  98-05 (G. Roullet)  Original code 
    107       !!        !  98-10 (G. Madec, M. Imbard)  release 8.2 
    108       !!   8.5  !  02-08 (G. Madec)  F90: Free form and module 
    109       !!        !  02-11 (C. Talandier, A-M Treguier) Open boundaries 
    110       !!   9.0  !  04-08 (C. Talandier) New trends organization 
    111       !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization 
     98      !! References : Roullet and Madec 1999, JGR. 
    11299      !!--------------------------------------------------------------------- 
    113       !! * Arguments 
    114100      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    115       INTEGER, INTENT( out ) ::   kindic     ! solver convergence flag 
    116                                              ! if the solver doesn t converge 
    117                                              ! the flag is < 0 
    118       !! * Local declarations 
     101      INTEGER, INTENT( out ) ::   kindic     ! solver convergence flag, <0 if the solver doesn t converge 
     102      !! 
    119103      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    120104      REAL(wp) ::   &              ! temporary scalars 
    … …  
    154138            spgv(ji,jj) = - grav * ( sshn(ji  ,jj+1) - sshn(ji,jj) ) / e2v(ji,jj) 
    155139         END DO  
    156  
    157140         !  Add the surface pressure trend to the general trend 
    158141         DO jk = 1, jpkm1 
    … …  
    162145            END DO 
    163146         END DO 
    164  
    165147         ! Evaluate the masked next velocity (effect of the additional force not included) 
    166148         DO jk = 1, jpkm1 
    … …  
    170152            END DO 
    171153         END DO 
    172  
    173154         !                                             ! =============== 
    174155      END DO                                           !   End of slab 
    … …  
    202183            spgv(ji,jj) = 0.e0 
    203184         END DO 
    204  
    205185         ! vertical sum 
    206186         DO jk = 1, jpk 
    … …  
    210190            END DO 
    211191         END DO 
    212  
    213192         ! transport: multiplied by the horizontal scale factor 
    214193         DO ji = 2, jpim1 
    … …  
    216195            spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj) 
    217196         END DO 
    218  
    219197         !                                             ! =============== 
    220198      END DO                                           !   End of slab 
    … …  
    302280            WRITE(ctmp1,*) ' ~~~~~~~~~~~~~~~~                not = ', nsolv 
    303281            CALL ctl_stop( ' dyn_spg_flt_jki : e r r o r, nsolv = 1, 2, 3 or 4', ctmp1 ) 
    304       ENDIF 
    305  
    306       !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    307  
    308 !CDIR PARALLEL DO 
    309 !$OMP PARALLEL DO 
     282         ENDIF 
     283      ENDIF 
     284 
     285      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     286 
    310287      !                                                ! =============== 
    311288      DO jj = 2, jpjm1                                 !  Vertical slab 
    … …  
    353330         ! 8. Sea surface elevation time stepping 
    354331         ! -------------------------------------- 
    355          ! Euler (forward) time stepping, no time filter 
    356          IF( neuler == 0 .AND. kt == nit000 ) THEN 
     332         IF( neuler == 0 .AND. kt == nit000 ) THEN         ! Euler (forward) time stepping, no time filter 
    357333            DO ji = 1, jpi 
    358334               ! after free surface elevation 
    … …  
    362338               sshn(ji,jj) = zssha 
    363339            END DO 
    364          ELSE 
    365             ! Leap-frog time stepping and time filter 
     340         ELSE                                              ! Leap-frog time stepping and time filter 
    366341            DO ji = 1, jpi 
    367342               ! after free surface elevation 
    … …  
    384359         CALL prt_ctl( tab2d_1=sshn, clinfo1=' spg  - ssh: ', mask1=tmask) 
    385360      ENDIF 
    386  
    387  
     361      ! 
    388362   END SUBROUTINE dyn_spg_flt_jki 
    389363 

  • trunk/NEMO/OPA_SRC/DYN/dynvor.F90

    r474 r503  
    55   !!                 planetary vorticity trends 
    66   !!====================================================================== 
     7   !! History :  1.0  !  89-12  (P. Andrich)  vor_ens: Original code 
     8   !!            5.0  !  91-11  (G. Madec) vor_ene, vor_mix: Original code 
     9   !!            6.0  !  96-01  (G. Madec)  s-coord, suppress work arrays 
     10   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     11   !!            8.5  !  04-02  (G. Madec)  vor_een: Original code 
     12   !!            9.0  !  03-08  (G. Madec)  vor_ctl: Original code 
     13   !!            9.0  !  05-11  (G. Madec)  dyn_vor: Original code (new step architecture) 
     14   !!---------------------------------------------------------------------- 
    715 
    816   !!---------------------------------------------------------------------- 
    … …  
    1422   !!       vor_ctl : control of the different vorticity option 
    1523   !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    17    USE oce             ! ocean dynamics and tracers 
    18    USE dom_oce         ! ocean space and time domain 
    19    USE in_out_manager  ! I/O manager 
    20    USE trdmod          ! ocean dynamics trends  
    21    USE trdmod_oce      ! ocean variables trends 
    22    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    23    USE prtctl          ! Print control 
     24   USE oce            ! ocean dynamics and tracers 
     25   USE dom_oce        ! ocean space and time domain 
     26   USE trdmod         ! ocean dynamics trends  
     27   USE trdmod_oce     ! ocean variables trends 
     28   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     29   USE prtctl         ! Print control 
     30   USE in_out_manager ! I/O manager 
    2431 
    2532   IMPLICIT NONE 
    2633   PRIVATE 
    2734 
    28    !! * Routine accessibility 
    29    PUBLIC dyn_vor      ! routine called by step.F90 
    30  
    31    !! * Shared module variables 
     35   PUBLIC   dyn_vor   ! routine called by step.F90 
     36 
     37   !!* Namelist nam_dynvor: vorticity term 
    3238   LOGICAL, PUBLIC ::   ln_dynvor_ene = .FALSE.   !: energy conserving scheme 
    3339   LOGICAL, PUBLIC ::   ln_dynvor_ens = .TRUE.    !: enstrophy conserving scheme 
    3440   LOGICAL, PUBLIC ::   ln_dynvor_mix = .FALSE.   !: mixed scheme 
    35    LOGICAL, PUBLIC ::   ln_dynvor_een = .FALSE.    !: energy and enstrophy conserving scheme 
    36  
    37    !! * module variables 
    38    INTEGER ::                        & 
    39       nvor = 0                         ! type of vorticity trend used 
     41   LOGICAL, PUBLIC ::   ln_dynvor_een = .FALSE.   !: energy and enstrophy conserving scheme 
     42   NAMELIST/nam_dynvor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een 
     43 
     44   INTEGER ::   nvor = 0   ! type of vorticity trend used 
    4045 
    4146   !! * Substitutions 
    … …  
    4348#  include "vectopt_loop_substitute.h90" 
    4449   !!---------------------------------------------------------------------- 
    45    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     50   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     51   !! $Header$ 
     52   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4653   !!---------------------------------------------------------------------- 
    4754 
    … …  
    5461      !! 
    5562      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    56       !!             - save the trends in (utrd,vtrd) in 2 parts (relative 
     63      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    5764      !!               and planetary vorticity trends) ('key_trddyn') 
    58       !! 
    59       !! History : 
    60       !!   9.0  !  05-11  (G. Madec)  Original code 
    61       !!---------------------------------------------------------------------- 
    62       USE oce, ONLY :    ztrdu => ta,     & ! use ta as 3D workspace 
    63                          ztrdv => sa        ! use sa as 3D workspace 
    64  
    65       !! * Arguments 
    66       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
     65      !!---------------------------------------------------------------------- 
     66      USE oce, ONLY :   ztrdu => ta   ! use ta as 3D workspace 
     67      USE oce, ONLY :   ztrdv => sa   ! use sa as 3D workspace 
     68      !! 
     69      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    6770      !!---------------------------------------------------------------------- 
    6871 
    … …  
    7477      CASE ( -1 )                                      ! esopa: test all possibility with control print 
    7578         CALL vor_ene( kt, 'TOT', ua, va ) 
    76          IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor0 - Ua: ', mask1=umask, & 
    77             &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     79         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor0 - Ua: ', mask1=umask, & 
     80            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    7881         CALL vor_ens( kt, 'TOT', ua, va ) 
    79          IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor1 - Ua: ', mask1=umask, & 
    80             &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     82         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor1 - Ua: ', mask1=umask, & 
     83            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8184         CALL vor_mix( kt ) 
    82          IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor2 - Ua: ', mask1=umask, & 
    83             &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     85         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor2 - Ua: ', mask1=umask, & 
     86            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8487         CALL vor_een( kt, 'TOT', ua, va ) 
    85          IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor3 - Ua: ', mask1=umask, & 
    86             &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     88         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor3 - Ua: ', mask1=umask, & 
     89            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8790 
    8891      CASE ( 0 )                                       ! energy conserving scheme 
    … …  
    9396            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    9497            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    95             CALL trd_mod( ztrdu, ztrdv, jpdtdrvo, 'DYN', kt ) 
     98            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt ) 
    9699            ztrdu(:,:,:) = ua(:,:,:) 
    97100            ztrdv(:,:,:) = va(:,:,:) 
    … …  
    99102            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    100103            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    101             CALL trd_mod( ztrdu, ztrdu, jpdtdpvo, 'DYN', kt ) 
    102             CALL trd_mod( ztrdu, ztrdv, jpdtddat, 'DYN', kt ) 
     104            CALL trd_mod( ztrdu, ztrdu, jpdyn_trd_pvo, 'DYN', kt ) 
     105            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 
    103106         ELSE 
    104107            CALL vor_ene( kt, 'TOT', ua, va )                ! total vorticity 
    … …  
    112115            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    113116            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    114             CALL trd_mod( ztrdu, ztrdv, jpdtdrvo, 'DYN', kt ) 
     117            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt ) 
    115118            ztrdu(:,:,:) = ua(:,:,:) 
    116119            ztrdv(:,:,:) = va(:,:,:) 
    … …  
    118121            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    119122            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    120             CALL trd_mod( ztrdu, ztrdu, jpdtdpvo, 'DYN', kt ) 
    121             CALL trd_mod( ztrdu, ztrdv, jpdtddat, 'DYN', kt ) 
     123            CALL trd_mod( ztrdu, ztrdu, jpdyn_trd_pvo, 'DYN', kt ) 
     124            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 
    122125         ELSE 
    123126            CALL vor_ens( kt, 'TOT', ua, va )                ! total vorticity 
    … …  
    131134            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    132135            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    133             CALL trd_mod( ztrdu, ztrdv, jpdtdrvo, 'DYN', kt ) 
     136            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt ) 
    134137            ztrdu(:,:,:) = ua(:,:,:) 
    135138            ztrdv(:,:,:) = va(:,:,:) 
    … …  
    137140            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    138141            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    139             CALL trd_mod( ztrdu, ztrdu, jpdtdpvo, 'DYN', kt ) 
    140             CALL trd_mod( ztrdu, ztrdv, jpdtddat, 'DYN', kt ) 
     142            CALL trd_mod( ztrdu, ztrdu, jpdyn_trd_pvo, 'DYN', kt ) 
     143            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 
    141144         ELSE 
    142145            CALL vor_mix( kt )                               ! total vorticity (mix=ens-ene) 
    … …  
    150153            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    151154            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    152             CALL trd_mod( ztrdu, ztrdv, jpdtdrvo, 'DYN', kt ) 
     155            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt ) 
    153156            ztrdu(:,:,:) = ua(:,:,:) 
    154157            ztrdv(:,:,:) = va(:,:,:) 
    … …  
    156159            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    157160            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    158             CALL trd_mod( ztrdu, ztrdu, jpdtdpvo, 'DYN', kt ) 
    159             CALL trd_mod( ztrdu, ztrdv, jpdtddat, 'DYN', kt ) 
     161            CALL trd_mod( ztrdu, ztrdu, jpdyn_trd_pvo, 'DYN', kt ) 
     162            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 
    160163         ELSE 
    161164            CALL vor_een( kt, 'TOT', ua, va )                ! total vorticity 
    … …  
    192195      !! 
    193196      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    194       !!             - save the trends in (utrd,vtrd) in 2 parts (relative 
     197      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    195198      !!               and planetary vorticity trends) ('key_trddyn') 
    196199      !! 
    197       !! References : 
    198       !!      Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    199       !! History : 
    200       !!   5.0  !  91-11  (G. Madec)  Original code 
    201       !!   6.0  !  96-01  (G. Madec)  s-coord, suppress work arrays 
    202       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    203       !!   9.0  !  04-08  (C. Talandier)  New trends organization 
    204       !!---------------------------------------------------------------------- 
    205       !! * Arguments 
    206       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    207       CHARACTER(len=3) , INTENT( in ) ::   & 
    208          cd_vor        ! define the vorticity considered 
    209          !             ! ='COR' (planetary) ; ='VOR' (relative) ; ='TOT' (total) 
    210       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
    211          pua, pva                      ! ???? 
    212  
    213       !! * Local declarations 
    214       INTEGER ::   ji, jj, jk               ! dummy loop indices 
    215       REAL(wp) ::   & 
    216          zfact2,                         &  ! temporary scalars 
    217          zx1, zx2, zy1, zy2                 !    "         " 
    218       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    219          zwx, zwy, zwz                      ! temporary workspace 
     200      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
     201      !!---------------------------------------------------------------------- 
     202      INTEGER          , INTENT(in   )                         ::   kt       ! ocean time-step index 
     203      CHARACTER(len=3) , INTENT(in   )                         ::   cd_vor   ! ='COR' (planetary) ; ='VOR' (relative) 
     204         !                                                                   ! ='TOT' (total) 
     205      REAL(wp)         , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua      ! total u-trend 
     206      REAL(wp)         , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva      ! total v-trend 
     207      !! 
     208      INTEGER  ::   ji, jj, jk         ! dummy loop indices 
     209      REAL(wp) ::   zx1, zy1, zfact2   ! temporary scalars 
     210      REAL(wp) ::   zx2, zy2           !    "         " 
     211      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! temporary 2D workspace 
    220212      !!---------------------------------------------------------------------- 
    221213 
    … …  
    234226      DO jk = 1, jpkm1                                 ! Horizontal slab 
    235227         !                                             ! =============== 
    236           
    237228         ! Potential vorticity and horizontal fluxes 
    238229         ! ----------------------------------------- 
    239230         SELECT CASE( cd_vor )      ! vorticity considered 
    240          CASE ( 'COR' )                   ! planetary vorticcity (Coriolis) 
    241             zwz(:,:) = ff(:,:) 
    242          CASE ( 'VOR' )                   ! relative  vorticity 
    243             zwz(:,:) = rotn(:,:,jk) 
    244          CASE ( 'TOT' )                   ! total     vorticity (planetary + relative) 
    245             zwz(:,:) = rotn(:,:,jk) + ff(:,:) 
     231         CASE ( 'COR' )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis) 
     232         CASE ( 'VOR' )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity 
     233         CASE ( 'TOT' )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total     vorticity  
    246234         END SELECT 
    247235 
    … …  
    270258      END DO                                           !   End of slab 
    271259      !                                                ! =============== 
    272  
    273260   END SUBROUTINE vor_ene 
    274261 
    … …  
    300287      !! 
    301288      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend 
    302       !!             - Save the trends in (utrd,vtrd) in 2 parts (relative 
     289      !!             - Save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    303290      !!               and planetary vorticity trends) ('key_trddyn') 
    304291      !! 
    305       !! References : 
    306       !!      Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    307       !! History : 
    308       !!   5.0  !  91-11  (G. Madec) Original code, enstrophy-energy-combined schemes 
    309       !!   6.0  !  96-01  (G. Madec) s-coord, suppress work arrays 
    310       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    311       !!   9.0  !  04-08  (C. Talandier)  New trends organization 
    312       !!---------------------------------------------------------------------- 
    313       !! * Arguments 
    314       INTEGER, INTENT( in ) ::   kt         ! ocean timestep index 
    315  
    316       !! * Local declarations 
    317       INTEGER ::   ji, jj, jk               ! dummy loop indices 
    318       REAL(wp) ::   & 
    319          zfact1, zfact2, zua, zva,       &  ! temporary scalars 
    320          zcua, zcva, zx1, zx2, zy1, zy2 
    321       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    322          zwx, zwy, zwz, zww                 ! temporary workspace 
     292      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
     293      !!---------------------------------------------------------------------- 
     294      INTEGER, INTENT(in) ::   kt   ! ocean timestep index 
     295      !! 
     296      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     297      REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! temporary scalars 
     298      REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !    "         " 
     299      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz, zww   ! temporary 3D workspace 
    323300      !!---------------------------------------------------------------------- 
    324301 
    … …  
    367344               zcua = zfact2 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    368345               zcva =-zfact2 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
    369  
     346               ! mixed vorticity trend added to the momentum trends 
    370347               ua(ji,jj,jk) = ua(ji,jj,jk) + zcua + zua 
    371348               va(ji,jj,jk) = va(ji,jj,jk) + zcva + zva 
    … …  
    375352      END DO                                           !   End of slab 
    376353      !                                                ! =============== 
    377  
    378354   END SUBROUTINE vor_mix 
    379355 
    … …  
    400376      !! 
    401377      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend 
    402       !!             - Save the trends in (utrd,vtrd) in 2 parts (relative  
     378      !!             - Save the trends in (ztrdu,ztrdv) in 2 parts (relative  
    403379      !!               and planetary vorticity trends) ('key_trddyn') 
    404380      !! 
    405       !! References : 
    406       !!      Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    407       !! History : 
    408       !!   5.0  !  91-11  (G. Madec)  Original code 
    409       !!   6.0  !  96-01  (G. Madec)  s-coord, suppress work arrays 
    410       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    411       !!   9.0  !  04-08  (C. Talandier)  New trends organization 
    412       !!---------------------------------------------------------------------- 
    413       !! * Arguments 
    414       INTEGER, INTENT( in ) ::   kt    ! ocean timestep 
    415       CHARACTER(len=3) , INTENT( in ) ::   & 
    416          cd_vor        ! define the vorticity considered 
    417          !             ! ='COR' (planetary) ; ='VOR' (relative) ; ='TOT' (total) 
    418       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
    419          pua, pva                      ! ???? 
    420  
    421       !! * Local declarations 
    422       INTEGER ::   ji, jj, jk          ! dummy loop indices 
    423       REAL(wp) ::   & 
    424          zfact1, zuav, zvau            ! temporary scalars 
    425       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    426          zwx, zwy, zwz                 ! temporary workspace 
     381      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
     382      !!---------------------------------------------------------------------- 
     383      INTEGER          , INTENT(in   )                         ::   kt       ! ocean time-step index 
     384      CHARACTER(len=3) , INTENT(in   )                         ::   cd_vor   ! ='COR' (planetary) ; ='VOR' (relative) 
     385         !                                                                   ! ='TOT' (total) 
     386      REAL(wp)         , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua      ! total u-trend 
     387      REAL(wp)         , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva      ! total v-trend 
     388      !! 
     389      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     390      REAL(wp) ::   zfact1, zuav, zvau   ! temporary scalars 
     391      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! temporary 3D workspace 
    427392      !!---------------------------------------------------------------------- 
    428393       
    … …  
    441406      DO jk = 1, jpkm1                                 ! Horizontal slab 
    442407         !                                             ! =============== 
    443  
    444408         ! Potential vorticity and horizontal fluxes 
    445409         ! ----------------------------------------- 
    446410         SELECT CASE( cd_vor )      ! vorticity considered 
    447          CASE ( 'COR' )                   ! planetary vorticcity (Coriolis) 
    448             zwz(:,:) = ff(:,:) 
    449          CASE ( 'VOR' )                   ! relative  vorticity 
    450             zwz(:,:) = rotn(:,:,jk) 
    451          CASE ( 'TOT' )                   ! total     vorticity (planetary + relative) 
    452             zwz(:,:) = rotn(:,:,jk) + ff(:,:) 
     411         CASE ( 'COR' )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis) 
     412         CASE ( 'VOR' )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity 
     413         CASE ( 'TOT' )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total     vorticity  
    453414         END SELECT 
    454415 
    … …  
    470431         ENDIF 
    471432 
    472  
    473433         ! Compute and add the vorticity term trend 
    474434         ! ---------------------------------------- 
    … …  
    476436            DO ji = fs_2, fs_jpim1   ! vector opt. 
    477437               zuav = zfact1 / e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & 
    478                                             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
     438                  &                         + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
    479439               zvau =-zfact1 / e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & 
    480                                             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
    481  
     440                  &                         + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
    482441               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    483442               pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
    … …  
    487446      END DO                                           !   End of slab 
    488447      !                                                ! =============== 
    489  
    490448   END SUBROUTINE vor_ens 
    491449 
    … …  
    509467      !! 
    510468      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    511       !!             - save the trends in (utrd,vtrd) in 2 parts (relative 
     469      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    512470      !!               and planetary vorticity trends) ('key_trddyn') 
    513471      !! 
    514       !! References : 
    515       !!      Arakawa and Lamb 1980, A potential enstrophy and energy conserving 
    516       !!                             scheme for the Shallow water equations,  
    517       !!                             Monthly Weather Review, vol. 109, p 18-36 
    518       !! 
    519       !! History : 
    520       !!   8.5  !  04-02  (G. Madec)  Original code 
    521       !!   9.0  !  04-08  (C. Talandier)  New trends organization 
    522       !!---------------------------------------------------------------------- 
    523       !! * Arguments 
    524       INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
    525       CHARACTER(len=3) , INTENT( in ) ::   & 
    526          cd_vor        ! define the vorticity considered 
    527          !             ! ='COR' (planetary) ; ='VOR' (relative) ; ='TOT' (total) 
    528       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
    529          pua, pva                      ! ???? 
    530  
    531       !! * Local declarations 
    532       INTEGER ::   ji, jj, jk              ! dummy loop indices 
    533       REAL(wp) ::   & 
    534          zfac12, zua, zva                  ! temporary scalars 
    535       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    536          zwx, zwy, zwz,                 &  ! temporary workspace 
    537          ztnw, ztne, ztsw, ztse            !    "           " 
    538       REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE ::   & 
    539          ze3f 
     472      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
     473      !!---------------------------------------------------------------------- 
     474      INTEGER          , INTENT(in   )                         ::   kt       ! ocean time-step index 
     475      CHARACTER(len=3) , INTENT(in   )                         ::   cd_vor   ! ='COR' (planetary) ; ='VOR' (relative) 
     476         !                                                                   ! ='TOT' (total) 
     477      REAL(wp)         , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua      ! total u-trend 
     478      REAL(wp)         , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva      ! total v-trend 
     479      !! 
     480      INTEGER ::   ji, jj, jk          ! dummy loop indices 
     481      REAL(wp) ::   zfac12, zua, zva   ! temporary scalars 
     482      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz            ! temporary 2D workspace 
     483      REAL(wp), DIMENSION(jpi,jpj) ::   ztnw, ztne, ztsw, ztse   ! temporary 3D workspace 
     484      REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE ::   ze3f 
    540485      !!---------------------------------------------------------------------- 
    541486 
    … …  
    570515         ! ----------------------------------------- 
    571516         SELECT CASE( cd_vor )      ! vorticity considered 
    572          CASE ( 'COR' )                   ! planetary vorticcity (Coriolis) 
    573             zwz(:,:) = ff(:,:) * ze3f(:,:,jk) 
    574          CASE ( 'VOR' )                   ! relative  vorticity 
    575             zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk) 
    576          CASE ( 'TOT' )                   ! total     vorticity (planetary + relative) 
    577             zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) 
     517         CASE ( 'COR' )   ;   zwz(:,:) =                  ff(:,:)   * ze3f(:,:,jk)   ! planetary vorticity (Coriolis) 
     518         CASE ( 'VOR' )   ;   zwz(:,:) =   rotn(:,:,jk)             * ze3f(:,:,jk)   ! relative  vorticity 
     519         CASE ( 'TOT' )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk)   ! total     vorticity  
    578520         END SELECT 
    579521 
    … …  
    599541            END DO 
    600542         END DO 
    601           
    602543         DO jj = 2, jpjm1 
    603544            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    613554      END DO                                           !   End of slab 
    614555      !                                                ! =============== 
    615  
    616556   END SUBROUTINE vor_een 
    617557 
    … …  
    623563      !! ** Purpose :   Control the consistency between cpp options for 
    624564      !!      tracer advection schemes 
    625       !! 
    626       !! History : 
    627       !!   9.0  !  03-08  (G. Madec)  Original code 
    628       !!---------------------------------------------------------------------- 
    629       !! * Local declarations 
     565      !!---------------------------------------------------------------------- 
    630566      INTEGER ::   ioptio          ! temporary integer 
    631  
    632       NAMELIST/nam_dynvor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een 
    633       !!---------------------------------------------------------------------- 
    634  
    635       ! Read Namelist nam_dynvor : Vorticity scheme options 
    636       ! ------------------------ 
    637       REWIND ( numnam ) 
     567      !!---------------------------------------------------------------------- 
     568 
     569      REWIND ( numnam )               ! Read Namelist nam_dynvor : Vorticity scheme options 
    638570      READ   ( numnam, nam_dynvor ) 
    639571 
    640       ! Control of vorticity scheme options 
    641       ! ----------------------------------- 
    642       ! Control print 
    643       IF(lwp) THEN 
     572      IF(lwp) THEN                    ! Namelist print 
    644573         WRITE(numout,*) 
    645574         WRITE(numout,*) 'dyn:vor_ctl : vorticity term : read namelist and control the consistency' 
    646575         WRITE(numout,*) '~~~~~~~~~~~' 
    647          WRITE(numout,*) '              Namelist nam_dynvor : oice of the vorticity term scheme' 
    648          WRITE(numout,*) '                 energy    conserving scheme                ln_dynvor_ene = ', ln_dynvor_ene 
    649          WRITE(numout,*) '                 enstrophy conserving scheme                ln_dynvor_ens = ', ln_dynvor_ens 
    650          WRITE(numout,*) '                 mixed enstrophy/energy conserving scheme   ln_dynvor_mix = ', ln_dynvor_mix 
    651          WRITE(numout,*) '                 enstrophy and energy conserving scheme     ln_dynvor_een = ', ln_dynvor_een 
     576         WRITE(numout,*) '        Namelist nam_dynvor : oice of the vorticity term scheme' 
     577         WRITE(numout,*) '           energy    conserving scheme                ln_dynvor_ene = ', ln_dynvor_ene 
     578         WRITE(numout,*) '           enstrophy conserving scheme                ln_dynvor_ens = ', ln_dynvor_ens 
     579         WRITE(numout,*) '           mixed enstrophy/energy conserving scheme   ln_dynvor_mix = ', ln_dynvor_mix 
     580         WRITE(numout,*) '           enstrophy and energy conserving scheme     ln_dynvor_een = ', ln_dynvor_een 
    652581      ENDIF 
    653582 
    654       ioptio = 0 
    655       IF( ln_dynvor_ene ) THEN 
    656          nvor = 0 
    657          IF(lwp) WRITE(numout,*) 
    658          IF(lwp) WRITE(numout,*) '              vorticity term : energy conserving scheme' 
    659          ioptio = ioptio + 1 
     583      ioptio = 0                     ! Control of vorticity scheme options 
     584      IF( ln_dynvor_ene )   ioptio = ioptio + 1 
     585      IF( ln_dynvor_ens )   ioptio = ioptio + 1 
     586      IF( ln_dynvor_mix )   ioptio = ioptio + 1 
     587      IF( ln_dynvor_een )   ioptio = ioptio + 1 
     588      IF( lk_esopa      )   ioptio =          1 
     589 
     590      IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' ) 
     591 
     592      !                              ! Set nvor 
     593      IF( ln_dynvor_ene )   nvor =  0 
     594      IF( ln_dynvor_ens )   nvor =  1 
     595      IF( ln_dynvor_mix )   nvor =  2 
     596      IF( ln_dynvor_een )   nvor =  3 
     597      IF( lk_esopa      )   nvor = -1 
     598       
     599      IF(lwp) THEN                   ! Print the choice 
     600         WRITE(numout,*) 
     601         IF( nvor ==  0 )   WRITE(numout,*) '         vorticity term used : energy conserving scheme' 
     602         IF( nvor ==  1 )   WRITE(numout,*) '         vorticity term used : enstrophy conserving scheme' 
     603         IF( nvor ==  2 )   WRITE(numout,*) '         vorticity term used : mixed enstrophy/energy conserving scheme' 
     604         IF( nvor ==  3 )   WRITE(numout,*) '         vorticity term used : energy and enstrophy conserving scheme' 
     605         IF( nvor == -1 )   WRITE(numout,*) '         esopa test: use all lateral physics options' 
    660606      ENDIF 
    661       IF( ln_dynvor_ens ) THEN 
    662          nvor = 1 
    663          IF(lwp) WRITE(numout,*) 
    664          IF(lwp) WRITE(numout,*) '              vorticity term : enstrophy conserving scheme' 
    665          ioptio = ioptio + 1 
    666       ENDIF 
    667       IF( ln_dynvor_mix ) THEN 
    668          nvor = 2 
    669          IF(lwp) WRITE(numout,*) 
    670          IF(lwp) WRITE(numout,*) '              vorticity term : mixed enstrophy/energy conserving scheme' 
    671          ioptio = ioptio + 1 
    672       ENDIF 
    673       IF( ln_dynvor_een ) THEN 
    674          nvor = 3 
    675          IF(lwp) WRITE(numout,*) 
    676          IF(lwp) WRITE(numout,*) '              vorticity term : energy and enstrophy conserving scheme' 
    677          ioptio = ioptio + 1 
    678       ENDIF 
    679       IF( ioptio /= 1 .AND. .NOT. lk_esopa ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' ) 
    680       IF( lk_esopa ) THEN 
    681          nvor = -1 
    682          IF(lwp ) WRITE(numout,*) '          esopa test: use all lateral physics options' 
    683       ENDIF 
    684       IF(lwp) WRITE(numout,*) '             choice of vor_...                nvor   = ', nvor 
    685  
     607      ! 
    686608   END SUBROUTINE vor_ctl 
    687609 
    688 !!============================================================================== 
     610   !!============================================================================== 
    689611END MODULE dynvor 

  • trunk/NEMO/OPA_SRC/DYN/dynzad.F90

    r455 r503  
    44   !! Ocean dynamics : vertical advection trend 
    55   !!====================================================================== 
     6   !! History :  6.0  !  91-01  (G. Madec) Original code 
     7   !!            7.0  !  91-11  (G. Madec) 
     8   !!            7.5  !  96-01  (G. Madec) statement function for e3 
     9   !!            8.5  !  02-07  (G. Madec) j-k-i case: Original code 
     10   !!            8.5  !  02-07  (G. Madec) Free form, F90 
     11   !!---------------------------------------------------------------------- 
    612    
    713   !!---------------------------------------------------------------------- 
    8    !!   dyn_zad      : vertical advection momentum trend 
    9    !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    11    USE oce             ! ocean dynamics and tracers 
    12    USE dom_oce         ! ocean space and time domain 
    13    USE in_out_manager  ! I/O manager 
    14    USE trdmod          ! ocean dynamics trends  
    15    USE trdmod_oce      ! ocean variables trends 
    16    USE flxrnf          ! ocean runoffs 
    17    USE prtctl          ! Print control 
     14   !!   dyn_zad       : vertical advection momentum trend 
     15   !!---------------------------------------------------------------------- 
     16   USE oce            ! ocean dynamics and tracers 
     17   USE dom_oce        ! ocean space and time domain 
     18   USE in_out_manager ! I/O manager 
     19   USE trdmod         ! ocean dynamics trends  
     20   USE trdmod_oce     ! ocean variables trends 
     21   USE flxrnf         ! ocean runoffs 
     22   USE prtctl         ! Print control 
    1823 
    1924   IMPLICIT NONE 
    2025   PRIVATE 
    2126    
    22    !! * Accessibility 
    23    PUBLIC dyn_zad                ! routine called by step.F90 
     27   PUBLIC   dyn_zad   ! routine called by step.F90 
    2428 
    2529   !! * Substitutions 
    … …  
    2933   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    3034   !! $Header$  
    31    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     35   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3236   !!---------------------------------------------------------------------- 
    3337 
    … …  
    5458      !! 
    5559      !! ** Action  : - Update (ua,va) with the vert. momentum advection trends 
    56       !!              - Save the trends in (utrd,vtrd) ('key_trddyn') 
    57       !! 
    58       !! History : 
    59       !!   6.0  !  91-01  (G. Madec) Original code 
    60       !!   7.0  !  91-11  (G. Madec) 
    61       !!   7.5  !  96-01  (G. Madec) statement function for e3 
    62       !!   8.5  !  02-07  (G. Madec) Free form, F90 
    63       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    64       !!---------------------------------------------------------------------- 
    65       !! * modules used 
    66       USE oce, ONLY:   zwuw => ta,   & ! use ta as 3D workspace 
    67                        zwvw => sa      ! use sa as 3D workspace 
    68  
    69       !! * Arguments 
    70       INTEGER, INTENT( in ) ::   kt    ! ocean time-step inedx 
    71        
    72       !! * Local declarations 
    73       INTEGER  ::   ji, jj, jk         ! dummy loop indices 
    74       REAL(wp) ::   zvn, zua, zva      ! temporary scalars 
    75       REAL(wp), DIMENSION(jpi) ::   & 
    76          zww                           ! temporary workspace 
    77       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    78          ztdua, ztdva                  ! temporary workspace 
     60      !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
     61      !!---------------------------------------------------------------------- 
     62      USE oce, ONLY:   zwuw => ta   ! use ta as 3D workspace 
     63      USE oce, ONLY:   zwvw => sa   ! use sa as 3D workspace 
     64      !! 
     65      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
     66      !! 
     67      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     68      REAL(wp) ::   zvn, zua, zva   ! temporary scalars 
     69      REAL(wp), DIMENSION(jpi)         ::   zww            ! 1D workspace 
     70      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace 
    7971      !!---------------------------------------------------------------------- 
    8072       
    … …  
    8577      ENDIF 
    8678 
    87       ! Save ua and va trends 
    88       IF( l_trddyn )   THEN 
    89          ztdua(:,:,:) = ua(:,:,:)  
    90          ztdva(:,:,:) = va(:,:,:)  
     79      IF( l_trddyn )   THEN         ! Save ua and va trends 
     80         ztrdu(:,:,:) = ua(:,:,:)  
     81         ztrdv(:,:,:) = va(:,:,:)  
    9182      ENDIF 
    9283 
    … …  
    9485      DO jj = 2, jpjm1                                 !  Vertical slab 
    9586         !                                             ! =============== 
    96  
    97          ! Vertical momentum advection at level w and u- and v- vertical 
    98          ! ---------------------------------------------------------------- 
    99          DO jk = 2, jpkm1 
    100             ! vertical fluxes  
    101             DO ji = 2, jpi 
     87         DO jk = 2, jpkm1         ! Vertical momentum advection at uw and vw-pts 
     88            DO ji = 2, jpi              ! vertical fluxes  
    10289               zww(ji) = 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) 
    10390            END DO 
    104             ! vertical momentum advection at w-point 
    105             DO ji = 2, jpim1 
     91            DO ji = 2, jpim1            ! vertical momentum advection at w-point 
    10692               zvn = 0.25 * e1t(ji,jj+1) * e2t(ji,jj+1) * wn(ji,jj+1,jk) 
    10793               zwuw(ji,jj,jk) = ( zww(ji+1) + zww(ji) ) * ( un(ji,jj,jk-1)-un(ji,jj,jk) ) 
    … …  
    10995            END DO   
    11096         END DO    
    111  
    112          ! Surface and bottom values set to zero 
    113          DO ji = 2, jpim1 
     97         DO ji = 2, jpim1               ! Surface and bottom values set to zero 
    11498            zwuw(ji,jj, 1 ) = 0.e0 
    11599            zwvw(ji,jj, 1 ) = 0.e0 
    … …  
    117101            zwvw(ji,jj,jpk) = 0.e0 
    118102         END DO   
    119  
    120          ! Vertical momentum advection at u- and v-points 
    121          ! ---------------------------------------------- 
    122          DO jk = 1, jpkm1 
     103         ! 
     104         DO jk = 1, jpkm1         ! Vertical momentum advection at u- and v-points 
    123105            DO ji = 2, jpim1 
    124                ! vertical momentum advective trends 
     106               !                        ! vertical momentum advective trends 
    125107               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    126108               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    127                ! add the trends to the general momentum trends 
     109               !                        ! add the trends to the general momentum trends 
    128110               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    129111               va(ji,jj,jk) = va(ji,jj,jk) + zva 
    … …  
    133115      END DO                                           !   End of slab 
    134116      !                                                ! =============== 
    135  
    136       ! save the vertical advection trends for diagnostic 
    137       ! momentum trends 
    138       IF( l_trddyn )   THEN 
    139          ztdua(:,:,:) = ua(:,:,:) - ztdua(:,:,:) 
    140          ztdva(:,:,:) = va(:,:,:) - ztdva(:,:,:) 
    141  
    142          CALL trd_mod(ztdua, ztdva, jpdtdzad, 'DYN', kt) 
    143       ENDIF 
    144  
    145       IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    146          CALL prt_ctl(tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask, & 
    147             &         tab3d_2=va, clinfo2=' Va: ', mask2=vmask, clinfo3='dyn') 
    148       ENDIF 
    149  
     117      ! 
     118      IF( l_trddyn ) THEN         ! save the vertical advection trends for diagnostic 
     119         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     120         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     121         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_zad, 'DYN', kt ) 
     122      ENDIF 
     123      !                           ! Control print 
     124      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask,   & 
     125         &                       tab3d_2=va, clinfo2=' Va: ', mask2=vmask, clinfo3='dyn' ) 
     126      ! 
    150127   END SUBROUTINE dyn_zad 
    151128 
    … …  
    169146      !! 
    170147      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends 
    171       !!              - Save the trends in (utrd,vtrd) ('key_trddyn') 
    172       !! 
    173       !! History : 
    174       !!   8.5  !  02-07  (G. Madec)  Original code 
    175       !!---------------------------------------------------------------------- 
    176       !! * modules used 
    177       USE oce, ONLY:   zwuw => ta,   & ! use ta as 3D workspace 
    178                        zwvw => sa      ! use sa as 3D workspace 
    179       !! * Arguments 
    180       INTEGER, INTENT( in ) ::   kt    ! ocean time-step inedx 
    181        
    182       !! * Local declarations 
    183       INTEGER  ::   ji, jj, jk         ! dummy loop indices 
    184       REAL(wp) ::   zua, zva           ! temporary scalars 
    185       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    186          zww                           ! temporary  workspace 
    187       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    188          ztdua, ztdva                  ! temporary workspace 
     148      !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
     149     !!---------------------------------------------------------------------- 
     150      USE oce, ONLY:   zwuw => ta   ! use ta as 3D workspace 
     151      USE oce, ONLY:   zwvw => sa   ! use sa as 3D workspace 
     152      !! 
     153      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
     154      !! 
     155      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     156      REAL(wp) ::   zua, zva        ! temporary scalars 
     157      REAL(wp), DIMENSION(jpi,jpj)     ::   zww            ! 2D  workspace 
     158      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace 
    189159      !!---------------------------------------------------------------------- 
    190160       
    … …  
    195165      ENDIF 
    196166 
    197       ! Save ua and va trends 
    198       IF( l_trddyn )   THEN 
    199          ztdua(:,:,:) = ua(:,:,:)  
    200          ztdva(:,:,:) = va(:,:,:)  
     167      IF( l_trddyn )   THEN         ! Save ua and va trends 
     168         ztrdu(:,:,:) = ua(:,:,:)  
     169         ztrdv(:,:,:) = va(:,:,:)  
    201170      ENDIF 
    202171       
    203       ! Vertical momentum advection at level w and u- and v- vertical 
    204       ! ------------------------------------------------------------- 
    205       DO jk = 2, jpkm1 
    206          ! vertical fluxes  
    207          DO jj = 2, jpj 
    208             DO ji = fs_2, jpi   ! vector opt. 
     172      DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical 
     173         DO jj = 2, jpj                   ! vertical fluxes  
     174            DO ji = fs_2, jpi             ! vector opt. 
    209175               zww(ji,jj) = 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) 
    210176            END DO 
    211177         END DO 
    212          ! vertical momentum advection at w-point 
    213          DO jj = 2, jpjm1 
    214             DO ji = fs_2, fs_jpim1   ! vector opt. 
     178         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point 
     179            DO ji = fs_2, fs_jpim1        ! vector opt. 
    215180               zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1)-un(ji,jj,jk) ) 
    216181               zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) ) 
    … …  
    218183         END DO    
    219184      END DO 
    220  
    221       ! Surface and bottom values set to zero 
    222       DO jj = 2, jpjm1 
    223          DO ji = fs_2, fs_jpim1   ! vector opt. 
     185      DO jj = 2, jpjm1              ! Surface and bottom values set to zero 
     186         DO ji = fs_2, fs_jpim1           ! vector opt. 
    224187            zwuw(ji,jj, 1 ) = 0.e0 
    225188            zwvw(ji,jj, 1 ) = 0.e0 
    … …  
    229192      END DO 
    230193 
    231  
    232       ! Vertical momentum advection at u- and v-points 
    233       ! ---------------------------------------------- 
    234       DO jk = 1, jpkm1 
     194      DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points 
    235195         DO jj = 2, jpjm1 
    236             DO ji = fs_2, fs_jpim1   ! vector opt. 
    237                ! vertical momentum advective trends 
     196            DO ji = fs_2, fs_jpim1       ! vector opt. 
     197               !                         ! vertical momentum advective trends 
    238198               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    239199               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    240                ! add the trends to the general momentum trends 
     200               !                         ! add the trends to the general momentum trends 
    241201               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    242202               va(ji,jj,jk) = va(ji,jj,jk) + zva 
    … …  
    245205      END DO 
    246206 
    247       ! save the vertical advection trends for diagnostic 
    248       ! momentum trends 
    249       IF( l_trddyn )   THEN 
    250          ztdua(:,:,:) = ua(:,:,:) - ztdua(:,:,:) 
    251          ztdva(:,:,:) = va(:,:,:) - ztdva(:,:,:) 
    252  
    253          CALL trd_mod(ztdua, ztdva, jpdtdzad, 'DYN', kt) 
    254       ENDIF 
    255  
    256       IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    257          CALL prt_ctl(tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask, & 
    258             &         tab3d_2=va, clinfo2=' Va: ', mask2=vmask, clinfo3='dyn') 
    259       ENDIF 
    260  
     207      IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic 
     208         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     209         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     210         CALL trd_mod(ztrdu, ztrdv, jpdyn_trd_zad, 'DYN', kt) 
     211      ENDIF 
     212      !                             ! Control print 
     213      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask,   & 
     214         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     215      ! 
    261216   END SUBROUTINE dyn_zad 
    262217#endif 
    263218 
    264 !!====================================================================== 
     219   !!====================================================================== 
    265220END MODULE dynzad 

  • trunk/NEMO/OPA_SRC/DYN/dynzdf.F90

    r456 r503  
    44   !! Ocean dynamics :  vertical component of the momentum mixing trend 
    55   !!============================================================================== 
     6   !! History :  9.0  !  05-11  (G. Madec)  Original code 
     7   !!---------------------------------------------------------------------- 
     8 
    69   !!---------------------------------------------------------------------- 
    710   !!   dyn_zdf      : Update the momentum trend with the vertical diffusion 
    8    !!       zdf_ctl  : ??? 
     11   !!       zdf_ctl  : initializations of the vertical diffusion scheme 
    912   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1113   USE oce             ! ocean dynamics and tracers variables 
    1214   USE dom_oce         ! ocean space and time domain variables  
    … …  
    2628   PRIVATE 
    2729 
    28    !! * Routine accessibility 
    29    PUBLIC dyn_zdf   !  routine called by step.F90 
     30   PUBLIC   dyn_zdf    !  routine called by step.F90 
    3031 
    31    !! * module variables 
    32    INTEGER ::                        & 
    33       nzdf = 0                         ! type vertical diffusion algorithm used 
     32   INTEGER  ::   nzdf = 0              ! type vertical diffusion algorithm used  
    3433      !                                ! defined from ln_zdf...  namlist logicals) 
    3534 
    36    !! * Module variables 
    37    REAL(wp) ::   & 
    38       r2dt                          ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
     35   REAL(wp) ::   r2dt                  ! time-step, = 2 rdttra 
     36      !                                ! except at nit000 (=rdttra) if neuler=0 
    3937 
    4038   !! * Substitutions 
    … …  
    4442   !!---------------------------------------------------------------------- 
    4543   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     44   !! $Header$ 
     45   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    4747 
    … …  
    5353      !! 
    5454      !! ** Purpose :   compute the vertical ocean dynamics physics. 
    55       !! ** Method  : 
    56       !! ** Action  : 
     55      !!--------------------------------------------------------------------- 
     56      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    5757      !! 
    58       !! History : 
    59       !!   9.0  !  05-11  (G. Madec)  Original code 
    60       !!--------------------------------------------------------------------- 
    61       !! * Arguments 
    62       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    63  
    64       !! * local declarations 
    65       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    66          ztrdu, ztrdv                    ! 3D temporary workspace 
     58      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace 
    6759      !!--------------------------------------------------------------------- 
    6860 
    … …  
    7062 
    7163      !                                          ! set time step 
    72       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    73          r2dt =  rdt                                    ! = rdtra (restarting with Euler time stepping) 
    74       ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1 
    75          r2dt = 2. * rdt                                ! = 2 rdttra (leapfrog) 
     64      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restarting with Euler time stepping) 
     65      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog) 
    7666      ENDIF 
    77  
    7867 
    7968      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    … …  
    8372 
    8473      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    85       CASE ( -1 )                                       ! esopa: test all possibility with control print 
    86          CALL dyn_zdf_exp    ( kt ) 
    87          CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask,               & 
    88             &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    89          CALL dyn_zdf_imp    ( kt ) 
    90          CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask,               & 
    91             &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    92          CALL dyn_zdf_imp_jki( kt ) 
    93          CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf2 - Ua: ', mask1=umask,               & 
    94             &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    95  
    96       CASE ( 0 )                                       ! explicit scheme 
    97          CALL dyn_zdf_exp    ( kt ) 
    98  
    99       CASE ( 1 )                                       ! implicit scheme (k-j-i loop) 
    100          CALL dyn_zdf_imp    ( kt ) 
    101  
    102       CASE ( 2 )                                       ! implicit scheme (j-k-i loop) 
    103          CALL dyn_zdf_imp_jki( kt ) 
    104  
     74      ! 
     75      CASE ( 0 )   ;   CALL dyn_zdf_exp    ( kt, r2dt )      ! explicit scheme 
     76      CASE ( 1 )   ;   CALL dyn_zdf_imp    ( kt, r2dt )      ! implicit scheme (k-j-i loop) 
     77      CASE ( 2 )   ;   CALL dyn_zdf_imp_jki( kt, r2dt )      ! implicit scheme (j-k-i loop) 
     78      ! 
     79      CASE ( -1 )                                      ! esopa: test all possibility with control print 
     80         ;             CALL dyn_zdf_exp    ( kt, r2dt ) 
     81         ;             CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask,               & 
     82            &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     83         ;             CALL dyn_zdf_imp    ( kt, r2dt ) 
     84         ;             CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask,               & 
     85            &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     86         ;             CALL dyn_zdf_imp_jki( kt, r2dt ) 
     87         ;             CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf2 - Ua: ', mask1=umask,               & 
     88            &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    10589      END SELECT 
    10690 
    107       IF( l_trddyn )   THEN                         ! save the vertical diffusive trends for further diagnostics 
     91      IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    10892         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    10993         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    110          CALL trd_mod( ztrdu, ztrdv, jpttdzdf, 'DYN', kt ) 
     94         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_zdf, 'DYN', kt ) 
    11195      ENDIF 
    112  
    11396      !                                          ! print mean trends (used for debugging) 
    11497      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf  - Ua: ', mask1=umask,               & 
    11598            &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    116  
     99      ! 
    117100   END SUBROUTINE dyn_zdf 
    118101 
    … …  
    122105      !!                 ***  ROUTINE zdf_ctl  *** 
    123106      !! 
    124       !! ** Purpose :   initializations of the vertical ocean dynamics physics 
     107      !! ** Purpose :   initializations of the vertical diffusion scheme 
    125108      !! 
    126109      !! ** Method  :   implicit (euler backward) scheme (default) 
    127110      !!                explicit (time-splitting) scheme if ln_zdfexp=T 
    128111      !!                OpenMP / NEC autotasking: use j-k-i loops 
    129       !! 
    130       !! History : 
    131       !!   9.0  !  05-11  (G. Madec)  Original code 
    132112      !!---------------------------------------------------------------------- 
    133       !! * Module used 
    134113      USE zdftke 
    135114      USE zdfkpp 
    136115      !!---------------------------------------------------------------------- 
    137116 
    138       !  Define the vertical dynamics physics scheme 
    139       ! ========================================== 
    140  
    141117      ! Choice from ln_zdfexp read in namelist in zdfini 
    142       IF( ln_zdfexp ) THEN               ! use explicit scheme 
    143          nzdf = 0 
    144       ELSE                               ! use implicit scheme 
    145          nzdf = 1 
     118      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme 
     119      ELSE                   ;   nzdf = 1           ! use implicit scheme 
    146120      ENDIF 
    147121 
    148122      ! Force implicit schemes 
    149       IF( lk_zdftke .OR. lk_zdfkpp   )   nzdf = 1      ! TKE or KPP physics 
    150       IF( ln_dynldf_iso              )   nzdf = 1      ! iso-neutral lateral physics 
    151       IF( ln_dynldf_hor .AND. ln_sco )   nzdf = 1      ! horizontal lateral physics in s-coordinate 
     123      IF( lk_zdftke .OR. lk_zdfkpp   )   nzdf = 1   ! TKE or KPP physics 
     124      IF( ln_dynldf_iso              )   nzdf = 1   ! iso-neutral lateral physics 
     125      IF( ln_dynldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate 
    152126 
    153127      ! OpenMP / NEC autotasking 
    154128#if defined key_mpp_omp 
    155       IF( nzdf == 1 )   nzdf = 2                       ! j-k-i loop 
     129      IF( nzdf == 1 )   nzdf = 2                    ! j-k-i loop 
    156130#endif 
    157131 
    158 !!bug 
    159 !     IF( ln_dynldf_iso              )   nzdf = 3      ! iso-neutral lateral physics 
    160 !     IF( ln_dynldf_hor .AND. ln_sco )   nzdf = 3      ! horizontal lateral physics in s-coordinate 
    161 !!bug 
    162       ! Test: esopa 
    163       IF( lk_esopa )    nzdf = -1                      ! All schemes used 
     132      IF( lk_esopa )    nzdf = -1                   ! Esopa key: All schemes used 
    164133 
    165       IF(lwp) THEN 
     134      IF(lwp) THEN                                  ! Print the choice 
    166135         WRITE(numout,*) 
    167136         WRITE(numout,*) 'dyn:zdf_ctl : vertical dynamics physics scheme' 
    … …  
    172141         IF( nzdf ==  2 )   WRITE(numout,*) '              Implicit (euler backward) scheme with j-k-i loops' 
    173142      ENDIF 
    174  
     143      ! 
    175144   END SUBROUTINE zdf_ctl 
    176145 

  • trunk/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r455 r503  
    44   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend 
    55   !!============================================================================== 
     6   !! History :      !  90-10  (B. Blanke)  Original code 
     7   !!                !  97-05  (G. Madec)  vertical component of isopycnal 
     8   !!           8.5  !  02-08  (G. Madec)  F90: Free form and module 
     9   !!---------------------------------------------------------------------- 
    610 
    711   !!---------------------------------------------------------------------- 
    … …  
    1620   USE in_out_manager  ! I/O manager 
    1721   USE taumod          ! surface ocean stress 
    18    USE prtctl          ! Print control 
    1922 
    2023   IMPLICIT NONE 
    … …  
    3033   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    3134   !! $Header$  
    32    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     35   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3336   !!---------------------------------------------------------------------- 
    3437 
    3538CONTAINS 
    3639 
    37    SUBROUTINE dyn_zdf_exp( kt ) 
     40   SUBROUTINE dyn_zdf_exp( kt, p2dt ) 
    3841      !!---------------------------------------------------------------------- 
    3942      !!                  ***  ROUTINE dyn_zdf_exp  *** 
    … …  
    5053      !! 
    5154      !! ** Action : - Update (ua,va) with the vertical diffusive trend 
    52       !!             - Save the trends in (ztdua,ztdva) ('key_trddyn') 
    53       !! 
    54       !! History : 
    55       !!        !  90-10  (B. Blanke)  Original code 
    56       !!        !  97-05  (G. Madec)  vertical component of isopycnal 
    57       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    58       !!   9.0  !  04-08  (C. Talandier)  New trends organization 
    5955      !!--------------------------------------------------------------------- 
    60       !! * Modules used      
    61       USE oce, ONLY :    ztdua => ta,    & ! use ta as 3D workspace    
    62                          ztdva => sa       ! use sa as 3D workspace    
    6356      !! * Arguments 
    64       INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
     57      INTEGER , INTENT( in ) ::   kt                           ! ocean time-step index 
     58      REAL(wp), INTENT( in ) ::   p2dt                         ! time-step  
    6559 
    6660      !! * Local declarations 
    67       INTEGER ::   & 
    68          ji, jj, jk, jl                    ! dummy loop indices 
    69       REAL(wp) ::   & 
    70          zrau0r, zlavmr, z2dt, zua, zva    ! temporary scalars 
    71       REAL(wp), DIMENSION(jpi,jpk) ::    & 
    72          zwx, zwy, zwz, zww                ! temporary workspace arrays 
     61      INTEGER ::   ji, jj, jk, jl                              ! dummy loop indices 
     62      REAL(wp) ::   zrau0r, zlavmr, zua, zva                   ! temporary scalars 
     63      REAL(wp), DIMENSION(jpi,jpk) ::   zwx, zwy, zwz, zww     ! temporary workspace arrays 
    7364      !!---------------------------------------------------------------------- 
    7465 
    … …  
    8374      zrau0r = 1. / rau0                                   ! inverse of the reference density 
    8475      zlavmr = 1. / float( n_zdfexp )                      ! inverse of the number of sub time step 
    85       z2dt = 2. * rdt                                      ! Leap-frog environnement 
    86  
    87       IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt    ! Euler time stepping when starting from rest 
    8876 
    8977      !                                                ! =============== 
    … …  
    124112                  va(ji,jj,jk) = va(ji,jj,jk) + zva 
    125113 
    126                   zwx(ji,jk) = zwx(ji,jk) + z2dt*zua*umask(ji,jj,jk) 
    127                   zwz(ji,jk) = zwz(ji,jk) + z2dt*zva*vmask(ji,jj,jk) 
     114                  zwx(ji,jk) = zwx(ji,jk) + p2dt*zua*umask(ji,jj,jk) 
     115                  zwz(ji,jk) = zwz(ji,jk) + p2dt*zva*vmask(ji,jj,jk) 
    128116               END DO   
    129117            END DO   

  • trunk/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r455 r503  
    44   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend 
    55   !!============================================================================== 
     6   !! History :      !  90-10  (B. Blanke)  Original code 
     7   !!                !  97-05  (G. Madec)  vertical component of isopycnal 
     8   !!           8.5  !  02-08  (G. Madec)  F90: Free form and module 
     9   !!---------------------------------------------------------------------- 
    610 
    711   !!---------------------------------------------------------------------- 
    … …  
    1115   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    1216   !! $Header$  
    13    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     17   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1418   !!---------------------------------------------------------------------- 
    1519   !! * Modules used 
    … …  
    2024   USE in_out_manager  ! I/O manager 
    2125   USE taumod          ! surface ocean stress 
    22    USE prtctl          ! Print control 
    2326 
    2427   IMPLICIT NONE 
    … …  
    4043 
    4144 
    42    SUBROUTINE dyn_zdf_imp( kt ) 
     45   SUBROUTINE dyn_zdf_imp( kt, p2dt ) 
    4346      !!---------------------------------------------------------------------- 
    4447      !!                  ***  ROUTINE dyn_zdf_imp  *** 
    … …  
    5861      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive 
    5962      !!               mixing trend. 
    60       !! 
    61       !! History : 
    62       !!        !  90-10  (B. Blanke)  Original code 
    63       !!        !  97-05  (G. Madec)  vertical component of isopycnal 
    64       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    65       !!   9.0  !  04-08  (C. Talandier)  New trends organization 
    6663      !!--------------------------------------------------------------------- 
    6764      !! * Modules used 
    68       USE oce, ONLY :  zwd   => ta,   &  ! use ta as workspace 
    69                        zws   => sa       ! use sa as workspace 
     65      USE oce, ONLY :  zwd   => ta,   &                ! use ta as workspace 
     66                       zws   => sa                     ! use sa as workspace 
    7067 
    7168      !! * Arguments 
    72       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     69      INTEGER , INTENT( in ) ::   kt                   ! ocean time-step index 
     70      REAL(wp), INTENT( in ) ::  p2dt                  ! vertical profile of tracer time-step 
    7371 
    7472      !! * Local declarations 
    75       INTEGER ::   ji, jj, jk            ! dummy loop indices 
    76       REAL(wp) ::   & 
    77          zrau0r, z2dt,                &  ! temporary scalars 
    78          z2dtf, zcoef, zzws, zrhs        !    "         " 
    79       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    80          zwi                             ! temporary workspace arrays 
     73      INTEGER ::   ji, jj, jk                          ! dummy loop indices 
     74      REAL(wp) ::   zrau0r, z2dtf, zcoef, zzws, zrhs   ! temporary scalars 
     75      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi        ! temporary workspace arrays 
    8176      !!---------------------------------------------------------------------- 
    8277 
    … …  
    9085      ! -------------------------------- 
    9186      zrau0r = 1. / rau0      ! inverse of the reference density 
    92       z2dt   = 2. * rdt       ! Leap-frog environnement 
    93  
    94       ! Euler time stepping when starting from rest 
    95       IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt 
    9687 
    9788      ! 1. Vertical diffusion on u 
    … …  
    10495         DO jj = 2, jpjm1  
    10596            DO ji = fs_2, fs_jpim1   ! vector opt. 
    106                zcoef = - z2dt / fse3u(ji,jj,jk) 
     97               zcoef = - p2dt / fse3u(ji,jj,jk) 
    10798               zwi(ji,jj,jk) = zcoef * avmu(ji,jj,jk  ) / fse3uw(ji,jj,jk  ) 
    10899               zzws          = zcoef * avmu(ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 
    … …  
    150141!!! change les resultats (derniers digit, pas significativement + rapide 1* de moins) 
    151142!!!         ua(ji,jj,1) = ub(ji,jj,1)  & 
    152 !!!                      + z2dt * ( ua(ji,jj,1) + taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) ) 
    153             z2dtf = z2dt / ( fse3u(ji,jj,1)*rau0 ) 
     143!!!                      + p2dt * ( ua(ji,jj,1) + taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) ) 
     144            z2dtf = p2dt / ( fse3u(ji,jj,1)*rau0 ) 
    154145            ua(ji,jj,1) = ub(ji,jj,1)  & 
    155                          + z2dt *  ua(ji,jj,1) + z2dtf * taux(ji,jj) 
    156          END DO 
    157       END DO 
    158       DO jk = 2, jpkm1 
    159          DO jj = 2, jpjm1    
    160             DO ji = fs_2, fs_jpim1   ! vector opt. 
    161                zrhs = ub(ji,jj,jk) + z2dt * ua(ji,jj,jk)   ! zrhs=right hand side 
     146                         + p2dt *  ua(ji,jj,1) + z2dtf * taux(ji,jj) 
     147         END DO 
     148      END DO 
     149      DO jk = 2, jpkm1 
     150         DO jj = 2, jpjm1    
     151            DO ji = fs_2, fs_jpim1   ! vector opt. 
     152               zrhs = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk)   ! zrhs=right hand side 
    162153               ua(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 
    163154            END DO 
    … …  
    183174         DO jj = 2, jpjm1    
    184175            DO ji = fs_2, fs_jpim1   ! vector opt. 
    185                ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) / z2dt 
     176               ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) / p2dt 
    186177            END DO 
    187178         END DO 
    … …  
    198189         DO jj = 2, jpjm1    
    199190            DO ji = fs_2, fs_jpim1   ! vector opt. 
    200                zcoef = -z2dt / fse3v(ji,jj,jk) 
     191               zcoef = -p2dt / fse3v(ji,jj,jk) 
    201192               zwi(ji,jj,jk) = zcoef * avmv(ji,jj,jk  ) / fse3vw(ji,jj,jk  ) 
    202193               zzws       = zcoef * avmv(ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 
    … …  
    245236!!! change les resultats (derniers digit, pas significativement + rapide 1* de moins) 
    246237!!!         va(ji,jj,1) = vb(ji,jj,1)  & 
    247 !!!                      + z2dt * ( va(ji,jj,1) + tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) ) 
    248             z2dtf = z2dt / ( fse3v(ji,jj,1)*rau0 ) 
     238!!!                      + p2dt * ( va(ji,jj,1) + tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) ) 
     239            z2dtf = p2dt / ( fse3v(ji,jj,1)*rau0 ) 
    249240            va(ji,jj,1) = vb(ji,jj,1)  & 
    250                          + z2dt * va(ji,jj,1) + z2dtf * tauy(ji,jj) 
     241                         + p2dt * va(ji,jj,1) + z2dtf * tauy(ji,jj) 
    251242         END DO 
    252243      END DO 
    … …  
    254245         DO jj = 2, jpjm1 
    255246            DO ji = fs_2, fs_jpim1   ! vector opt. 
    256                zrhs = vb(ji,jj,jk) + z2dt * va(ji,jj,jk)   ! zrhs=right hand side 
     247               zrhs = vb(ji,jj,jk) + p2dt * va(ji,jj,jk)   ! zrhs=right hand side 
    257248               va(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 
    258249            END DO 
    … …  
    274265      END DO 
    275266 
    276 ! flux de surface doit etre calcule dans trdmod et boootom stress 
    277 ! deduit par integration verticale dans trmod pour jpdtdzdf 
    278 !RB      IF( l_trddyn )  THEN  
    279 !         ! diagnose surface and bottom momentum fluxes 
    280 !         DO jj = 2, jpjm1    
    281 !            DO ji = fs_2, fs_jpim1   ! vector opt. 
    282 !               ! save the surface forcing momentum fluxes 
    283 !               ztsy(ji,jj) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 
    284 !               ztsx(ji,jj) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) 
    285 !               ! save bottom friction momentum fluxes 
    286 !               ikbv   = MIN( mbathy(ji,jj+1), mbathy(ji,jj) ) 
    287 !               ikbvm1 = MAX( ikbv-1, 1 ) 
    288 !               ztby(ji,jj) = - avmv(ji,jj,ikbv) * va(ji,jj,ikbvm1)   & 
    289 !                  / ( fse3v(ji,jj,ikbvm1)*fse3vw(ji,jj,ikbv) ) 
    290 !               ! subtract surface forcing and bottom friction trend from vertical 
    291 !               ! diffusive momentum trend 
    292 !               ztdva(ji,jj,1     ) = ztdva(ji,jj,1     ) - ztsy(ji,jj) 
    293 !               ztdva(ji,jj,ikbvm1) = ztdva(ji,jj,ikbvm1) - ztby(ji,jj) 
    294 !            END DO 
    295 !         END DO 
    296 !      ENDIF 
    297  
    298267      ! Normalization to obtain the general momentum trend va 
    299268      DO jk = 1, jpkm1 
    300269         DO jj = 2, jpjm1    
    301270            DO ji = fs_2, fs_jpim1   ! vector opt. 
    302                va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) / z2dt 
     271               va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) / p2dt 
    303272            END DO 
    304273         END DO 

  • trunk/NEMO/OPA_SRC/DYN/dynzdf_imp_jki.F90

    r456 r503  
    44   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend 
    55   !!============================================================================== 
     6   !! History : 8.5  !  02-08  (G. Madec)  auto-tasking option 
     7   !!---------------------------------------------------------------------- 
    68 
    79   !!---------------------------------------------------------------------- 
    … …  
    1719   USE in_out_manager  ! I/O manager 
    1820   USE taumod          ! surface ocean stress 
    19    USE prtctl          ! Print control 
    2021 
    2122   IMPLICIT NONE 
    … …  
    3031   !!---------------------------------------------------------------------- 
    3132   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     33   !! $Header$  
     34   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3235   !!---------------------------------------------------------------------- 
    3336 
    3437CONTAINS 
    3538 
    36    SUBROUTINE dyn_zdf_imp_jki( kt ) 
     39   SUBROUTINE dyn_zdf_imp_jki( kt, p2dt ) 
    3740      !!---------------------------------------------------------------------- 
    3841      !!                  ***  ROUTINE dyn_zdf_imp_jki  *** 
    … …  
    5255      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive 
    5356      !!               mixing trend. 
    54       !! 
    55       !! History : 
    56       !!   8.5  !  02-08  (G. Madec)  auto-tasking option 
    57       !!   9.0  !  04-08  (C. Talandier)  New trends organization 
    5857      !!--------------------------------------------------------------------- 
    59       !! * Modules used      
    60       USE oce, ONLY :    ztdua => ta,  & ! use ta as 3D workspace    
    61                          ztdva => sa     ! use sa as 3D workspace    
    62  
    6358      !! * Arguments 
    64       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     59      INTEGER , INTENT( in ) ::   kt                          ! ocean time-step index 
     60      REAL(wp), INTENT( in ) ::   p2dt                        ! ocean time-step index 
    6561 
    6662      !! * Local declarations 
    67       INTEGER ::   ji, jj, jk            ! dummy loop indices 
    68       INTEGER ::   ikst, ikenm2, ikstp1  ! temporary integers 
    69       REAL(wp) ::  zrau0r, z2dt,       & !temporary scalars 
    70          &         z2dtf, zcoef, zzws 
    71       REAL(wp), DIMENSION(jpi,jpk) ::  & 
    72          zwx, zwy, zwz,                & ! workspace 
    73          zwd, zws, zwi, zwt 
     63      INTEGER ::   ji, jj, jk                                 ! dummy loop indices 
     64      INTEGER ::   ikst, ikenm2, ikstp1                       ! temporary integers 
     65      REAL(wp) ::  zrau0r, z2dtf, zcoef, zzws                 ! temporary scalars 
     66      REAL(wp), DIMENSION(jpi,jpk) ::  zwx, zwy, zwz,       & ! workspace 
     67         &                             zwd, zws, zwi, zwt 
    7468      !!---------------------------------------------------------------------- 
    7569 
    … …  
    8478      ! -------------------------------- 
    8579      zrau0r = 1. / rau0      ! inverse of the reference density 
    86       z2dt   = 2. * rdt       ! Leap-frog environnement 
    87  
    88       ! Euler time stepping when starting from rest 
    89       IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt 
    9080 
    9181      !                                                ! =============== 
    … …  
    10191         DO jk = 1, jpkm1 
    10292            DO ji = 2, jpim1 
    103                zcoef = - z2dt / fse3u(ji,jj,jk) 
     93               zcoef = - p2dt / fse3u(ji,jj,jk) 
    10494               zwi(ji,jk) = zcoef * avmu(ji,jj,jk  ) / fse3uw(ji,jj,jk  ) 
    10595               zzws       = zcoef * avmu(ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 
    10696               zws(ji,jk) = zzws * umask(ji,jj,jk+1) 
    10797               zwd(ji,jk) = 1. - zwi(ji,jk) - zzws 
    108                zwy(ji,jk) = ub(ji,jj,jk) + z2dt * ua(ji,jj,jk) 
     98               zwy(ji,jk) = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk) 
    10999            END DO 
    110100         END DO 
    … …  
    112102         ! Surface boudary conditions 
    113103         DO ji = 2, jpim1 
    114             z2dtf = z2dt / ( fse3u(ji,jj,1)*rau0 ) 
     104            z2dtf = p2dt / ( fse3u(ji,jj,1)*rau0 ) 
    115105            zwi(ji,1) = 0. 
    116106            zwd(ji,1) = 1. - zws(ji,1) 
    … …  
    175165         DO jk = 1, jpkm1 
    176166            DO ji = 2, jpim1 
    177                ua(ji,jj,jk) = ( zwx(ji,jk) - ub(ji,jj,jk) ) / z2dt 
     167               ua(ji,jj,jk) = ( zwx(ji,jk) - ub(ji,jj,jk) ) / p2dt 
    178168            END DO 
    179169         END DO 
    … …  
    188178         DO jk = 1, jpkm1 
    189179            DO ji = 2, jpim1 
    190                zcoef = -z2dt/fse3v(ji,jj,jk) 
     180               zcoef = -p2dt/fse3v(ji,jj,jk) 
    191181               zwi(ji,jk) = zcoef * avmv(ji,jj,jk  ) / fse3vw(ji,jj,jk  ) 
    192182               zzws       = zcoef * avmv(ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 
    193183               zws(ji,jk) =  zzws * vmask(ji,jj,jk+1) 
    194184               zwd(ji,jk) = 1. - zwi(ji,jk) - zzws 
    195                zwy(ji,jk) = vb(ji,jj,jk) + z2dt * va(ji,jj,jk) 
     185               zwy(ji,jk) = vb(ji,jj,jk) + p2dt * va(ji,jj,jk) 
    196186            END DO 
    197187         END DO 
    … …  
    199189         ! Surface boudary conditions 
    200190         DO ji = 2, jpim1 
    201             z2dtf = z2dt / ( fse3v(ji,jj,1)*rau0 ) 
     191            z2dtf = p2dt / ( fse3v(ji,jj,1)*rau0 ) 
    202192            zwi(ji,1) = 0.e0 
    203193            zwd(ji,1) = 1. - zws(ji,1) 
    … …  
    262252         DO jk = 1, jpkm1 
    263253            DO ji = 2, jpim1 
    264                va(ji,jj,jk) = ( zwx(ji,jk) - vb(ji,jj,jk) ) / z2dt 
     254               va(ji,jj,jk) = ( zwx(ji,jk) - vb(ji,jj,jk) ) / p2dt 
    265255            END DO 
    266256         END DO 

  • trunk/NEMO/OPA_SRC/TRA/traadv.F90

    r474 r503  
    44   !! Ocean active tracers:  advection trend  
    55   !!============================================================================== 
    6    !! History : 
    7    !!   9.0  !  05-11  (G. Madec)  Original code 
     6   !! History :  9.0  !  05-11  (G. Madec)  Original code 
     7   !!---------------------------------------------------------------------- 
     8 
    89   !!---------------------------------------------------------------------- 
    910   !!   tra_adv      : compute ocean tracer advection trend 
    1011   !!   tra_adv_ctl  : control the different options of advection scheme 
    1112   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1313   USE oce             ! ocean dynamics and active tracers 
    1414   USE dom_oce         ! ocean space and time domain 
    15    USE traadv_cen2     ! 2nd order centered scheme   (tra_adv_cen2 routine) 
    16    USE traadv_cen2_jki ! 2nd order centered scheme   (tra_adv_cen2 routine) 
    17    USE traadv_tvd      ! TVD scheme                (tra_adv_tvd    routine) 
    18    USE traadv_muscl    ! MUSCL scheme              (tra_adv_muscl  routine) 
     15   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2  routine) 
     16   USE traadv_cen2_jki ! 2nd order centered scheme (tra_adv_cen2  routine) 
     17   USE traadv_tvd      ! TVD    scheme             (tra_adv_tvd    routine) 
     18   USE traadv_muscl    ! MUSCL  scheme             (tra_adv_muscl  routine) 
    1919   USE traadv_muscl2   ! MUSCL2 scheme             (tra_adv_muscl2 routine) 
     20   USE traadv_ubs      ! UBS    scheme             (tra_adv_ubs    routine) 
    2021   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    21    USE trabbl          ! ??? 
    22    USE ldftra_oce      ! ??? 
     22   USE trabbl          ! tracers: bottom boundary layer 
     23   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    2324   USE in_out_manager  ! I/O manager 
    2425   USE prtctl          ! Print control 
    … …  
    2728   PRIVATE 
    2829 
    29    !! * Accessibility 
    30    PUBLIC tra_adv         ! routine called by step module 
     30   PUBLIC   tra_adv    ! routine called by step module 
    3131  
    32    !! * Share module variables 
    33    LOGICAL, PUBLIC ::   & 
    34       ln_traadv_cen2   = .TRUE.  ,   &  ! 2nd order centered scheme flag 
    35       ln_traadv_tvd    = .FALSE. ,   &  ! TVD scheme flag 
    36       ln_traadv_muscl  = .FALSE. ,   &  ! MUSCL scheme flag 
    37       ln_traadv_muscl2 = .FALSE.        ! MUSCL2 scheme flag 
     32   !!* Namelist nam_traadv 
     33   LOGICAL, PUBLIC ::   ln_traadv_cen2   = .TRUE.       ! 2nd order centered scheme flag 
     34   LOGICAL, PUBLIC ::   ln_traadv_tvd    = .FALSE.      ! TVD scheme flag 
     35   LOGICAL, PUBLIC ::   ln_traadv_muscl  = .FALSE.      ! MUSCL scheme flag 
     36   LOGICAL, PUBLIC ::   ln_traadv_muscl2 = .FALSE.      ! MUSCL2 scheme flag 
     37   LOGICAL, PUBLIC ::   ln_traadv_ubs    = .FALSE.      ! UBS scheme flag 
     38   NAMELIST/nam_traadv/ ln_traadv_cen2 , ln_traadv_tvd,   & 
     39      &                 ln_traadv_muscl, ln_traadv_muscl2, ln_traadv_ubs 
    3840 
    39    !! * Module variables 
    40    INTEGER ::   & 
    41       nadv                              ! choice of the type of advection scheme 
     41   INTEGER ::   nadv   ! choice of the type of advection scheme 
    4242 
    4343   !! * Substitutions 
    44 #   include "domzgr_substitute.h90" 
    45 #   include "vectopt_loop_substitute.h90" 
     44#  include "domzgr_substitute.h90" 
     45#  include "vectopt_loop_substitute.h90" 
    4646   !!---------------------------------------------------------------------- 
    47    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     47   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     48   !! $Header$  
     49   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4850   !!---------------------------------------------------------------------- 
    4951 
    … …  
    5658      !! ** Purpose :   compute the ocean tracer advection trend. 
    5759      !! 
     60      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    5861      !!---------------------------------------------------------------------- 
    5962#if ( defined key_trabbl_adv || defined key_traldf_eiv ) 
    60       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  &  ! temporary arrays 
    61          &         zun, zvn, zwn 
     63      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn   ! effective velocity 
    6264#else 
    63       USE oce                , zun => un,  &  ! When no advective bbl, zun == un 
    64          &                     zvn => vn,  &  !      "        "      , zvn == vn 
    65          &                     zwn => wn      !      "        "      , zwn == wn 
     65      USE oce, ONLY :                       zun => un       ! the effective velocity is the 
     66      USE oce, ONLY :                       zvn => vn       ! Eulerian velocity 
     67      USE oce, ONLY :                       zwn => wn       !  
    6668#endif 
    67  
    68       !! * Arguments 
    69       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
     69      !! 
     70      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    7071      !!---------------------------------------------------------------------- 
    7172 
    72       IF( kt == nit000 )   CALL tra_adv_ctl                  ! initialisation & control of options 
     73      IF( kt == nit000 )   CALL tra_adv_ctl          ! initialisation & control of options 
    7374 
    7475#if defined key_trabbl_adv 
    75       ! Advective bottom boundary layer                      ! add the bbl velocity 
    76       ! ------------------------------- 
    77       zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:) 
     76      zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:)          ! add the bbl velocity 
    7877      zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:) 
    7978      zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:) 
    8079#endif 
    81       IF( lk_traldf_eiv ) THEN                               ! add the eiv velocity 
     80      IF( lk_traldf_eiv ) THEN                       ! commpute and add the eiv velocity 
    8281         IF( .NOT. lk_trabbl_adv ) THEN  
    8382            zun(:,:,:) = un(:,:,:) 
    … …  
    8584            zwn(:,:,:) = wn(:,:,:) 
    8685         ENDIF 
    87          CALL tra_adv_eiv( kt, zun, zvn, zwn )                  ! compute and add the eiv velocity  
     86         CALL tra_adv_eiv( kt, zun, zvn, zwn )  
    8887      ENDIF 
    8988 
    90       SELECT CASE ( nadv )                       ! compute advection trend and add it to general trend 
    91       CASE ( -1 )                                       ! esopa: test all possibility with control print 
    92          CALL tra_adv_cen2    ( kt, zun, zvn, zwn ) 
    93          CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf0 - Ta: ', mask1=tmask,               & 
    94             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    95          CALL tra_adv_cen2_jki( kt, zun, zvn, zwn ) 
    96          CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf1 - Ta: ', mask1=tmask,               & 
    97             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    98          CALL tra_adv_tvd     ( kt, zun, zvn, zwn ) 
    99          CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf2 - Ta: ', mask1=tmask,               & 
    100             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    101          CALL tra_adv_muscl   ( kt, zun, zvn, zwn ) 
    102          CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf3 - Ta: ', mask1=tmask,               & 
    103             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    104          CALL tra_adv_muscl2  ( kt, zun, zvn, zwn ) 
    105          CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf4 - Ta: ', mask1=tmask,               & 
    106             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    107  
    108       CASE ( 0 )                                       ! 2nd order centered scheme k-j-i loops 
    109          CALL tra_adv_cen2    ( kt, zun, zvn, zwn ) 
    110       CASE ( 1 )                                       ! 2nd order centered scheme 
    111          CALL tra_adv_cen2_jki( kt, zun, zvn, zwn ) 
    112       CASE ( 2 )                                       ! TVD scheme 
    113          CALL tra_adv_tvd    ( kt, zun, zvn, zwn ) 
    114       CASE ( 3 )                                       ! MUSCL  scheme 
    115          CALL tra_adv_muscl  ( kt, zun, zvn, zwn ) 
    116       CASE ( 4 )                                       ! MUSCL2 scheme 
    117          CALL tra_adv_muscl2 ( kt, zun, zvn, zwn ) 
     89      SELECT CASE ( nadv )                           ! compute advection trend and add it to general trend 
     90      CASE ( 0 )   ;   CALL tra_adv_cen2    ( kt, zun, zvn, zwn )    ! 2nd order centered scheme k-j-i loops 
     91      CASE ( 1 )   ;   CALL tra_adv_cen2_jki( kt, zun, zvn, zwn )    ! 2nd order centered scheme 
     92      CASE ( 2 )   ;   CALL tra_adv_tvd     ( kt, zun, zvn, zwn )    ! TVD    scheme 
     93      CASE ( 3 )   ;   CALL tra_adv_muscl   ( kt, zun, zvn, zwn )    ! MUSCL  scheme 
     94      CASE ( 4 )   ;   CALL tra_adv_muscl2  ( kt, zun, zvn, zwn )    ! MUSCL2 scheme 
     95      CASE ( 5 )   ;   CALL tra_adv_ubs     ( kt, zun, zvn, zwn )    ! UBS    scheme 
     96      ! 
     97      CASE (-1 )                                                     ! esopa: test all possibility with control print 
     98         ;             CALL tra_adv_cen2    ( kt, zun, zvn, zwn ) 
     99         ;             CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf0 - Ta: ', mask1=tmask,               & 
     100            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     101         ;             CALL tra_adv_cen2_jki( kt, zun, zvn, zwn ) 
     102         ;             CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf1 - Ta: ', mask1=tmask,               & 
     103            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     104         ;             CALL tra_adv_tvd     ( kt, zun, zvn, zwn ) 
     105         ;             CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf2 - Ta: ', mask1=tmask,               & 
     106            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     107         ;             CALL tra_adv_muscl   ( kt, zun, zvn, zwn ) 
     108         ;             CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf3 - Ta: ', mask1=tmask,               & 
     109            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     110         ;             CALL tra_adv_muscl2  ( kt, zun, zvn, zwn ) 
     111         ;             CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf4 - Ta: ', mask1=tmask,               & 
     112            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     113         ;             CALL tra_adv_ubs     ( kt, zun, zvn, zwn ) 
     114         ;             CALL prt_ctl( tab3d_1=ta, clinfo1=' adv5 - Ta: ', mask1=tmask,               & 
     115            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    118116      END SELECT 
    119  
    120       !                                                ! print mean trends (used for debugging) 
    121 !      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' adv  - Ta: ', mask1=tmask,               & 
    122 !         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    123  
     117      !                                              ! print mean trends (used for debugging) 
     118      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' adv  - Ta: ', mask1=tmask,               & 
     119         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     120      ! 
    124121   END SUBROUTINE tra_adv 
    125122 
    … …  
    129126      !!                  ***  ROUTINE tra_adv_ctl  *** 
    130127      !!                 
    131       !! ** Purpose :   Control the consistency between cpp options for  
    132       !!      tracer advection schemes 
    133       !! 
     128      !! ** Purpose :   Control the consistency between namelist options for  
     129      !!              tracer advection schemes and set nadv 
    134130      !!---------------------------------------------------------------------- 
    135131      INTEGER ::   ioptio 
    136       NAMELIST/nam_traadv/ ln_traadv_cen2 , ln_traadv_tvd,   & 
    137          &                 ln_traadv_muscl, ln_traadv_muscl2 
    138132      !!---------------------------------------------------------------------- 
    139133 
    140       ! Read Namelist nam_traadv : tracer advection scheme 
    141       ! ------------------------- 
    142       REWIND ( numnam ) 
     134      REWIND ( numnam )               ! Read Namelist nam_traadv : tracer advection scheme 
    143135      READ   ( numnam, nam_traadv ) 
    144136 
    145       ! Parameter control and print 
    146       ! --------------------------- 
    147       ! Control print 
    148       IF(lwp) THEN 
     137      IF(lwp) THEN                    ! Namelist print 
    149138         WRITE(numout,*) 
    150139         WRITE(numout,*) 'tra_adv_ctl : choice/control of the tracer advection scheme' 
    151140         WRITE(numout,*) '~~~~~~~~~~~' 
    152          WRITE(numout,*) '          Namelist nam_tra_adv : chose a advection scheme for tracers' 
    153          WRITE(numout,*) 
    154          WRITE(numout,*) '             2nd order advection scheme     ln_traadv_cen2   = ', ln_traadv_cen2 
    155          WRITE(numout,*) '             TVD advection scheme           ln_traadv_tvd    = ', ln_traadv_tvd 
    156          WRITE(numout,*) '             MUSCL  advection scheme        ln_traadv_muscl  = ', ln_traadv_muscl 
    157          WRITE(numout,*) '             MUSCL2 advection scheme        ln_traadv_muscl2 = ', ln_traadv_muscl2 
     141         WRITE(numout,*) '       Namelist nam_traadv : chose a advection scheme for tracers' 
     142         WRITE(numout,*) '          2nd order advection scheme     ln_traadv_cen2   = ', ln_traadv_cen2 
     143         WRITE(numout,*) '          TVD advection scheme           ln_traadv_tvd    = ', ln_traadv_tvd 
     144         WRITE(numout,*) '          MUSCL  advection scheme        ln_traadv_muscl  = ', ln_traadv_muscl 
     145         WRITE(numout,*) '          MUSCL2 advection scheme        ln_traadv_muscl2 = ', ln_traadv_muscl2 
     146         WRITE(numout,*) '          UBS    advection scheme        ln_traadv_ubs    = ', ln_traadv_ubs 
    158147      ENDIF 
    159148 
    160       ! Control of Advection scheme options 
    161       ! ----------------------------------- 
    162       ioptio = 0 
     149      ioptio = 0                      ! Parameter control 
    163150      IF( ln_traadv_cen2   )   ioptio = ioptio + 1 
    164151      IF( ln_traadv_tvd    )   ioptio = ioptio + 1 
    165152      IF( ln_traadv_muscl  )   ioptio = ioptio + 1 
    166153      IF( ln_traadv_muscl2 )   ioptio = ioptio + 1 
     154      IF( ln_traadv_ubs    )   ioptio = ioptio + 1 
     155      IF( lk_esopa         )   ioptio =          1 
    167156 
    168       IF( .NOT.lk_esopa .AND. ( ioptio > 1 .OR. ioptio == 0 ) ) & 
    169            &   CALL ctl_stop( ' Choose ONE advection scheme in namelist nam_traadv' ) 
     157      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist nam_traadv' ) 
    170158 
    171       IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) & 
    172            &   CALL ctl_stop( '     cross-land advection only with 2nd order advection scheme' ) 
     159      IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 )   & 
     160         &                CALL ctl_stop( 'cross-land advection only with 2nd order advection scheme' ) 
    173161 
    174       ! Set nadv 
    175       ! -------- 
    176       IF( ln_traadv_cen2   )   nadv = 0 
     162      !                              ! Set nadv 
     163      IF( ln_traadv_cen2   )   nadv =  0 
    177164#if defined key_mpp_omp 
    178       IF( ln_traadv_cen2   )   nadv = 1 
     165      IF( ln_traadv_cen2   )   nadv =  1 
    179166#endif 
    180       IF( ln_traadv_tvd    )   nadv = 2 
    181       IF( ln_traadv_muscl  )   nadv = 3 
    182       IF( ln_traadv_muscl2 )   nadv = 4 
     167      IF( ln_traadv_tvd    )   nadv =  2 
     168      IF( ln_traadv_muscl  )   nadv =  3 
     169      IF( ln_traadv_muscl2 )   nadv =  4 
     170      IF( ln_traadv_ubs    )   nadv =  5 
     171      IF( lk_esopa         )   nadv = -1 
    183172 
    184       IF( lk_esopa ) THEN 
    185          IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options' 
    186          nadv = -1 
     173      IF(lwp) THEN                   ! Print the choice 
     174         WRITE(numout,*) 
     175         IF( nadv ==  0 )   WRITE(numout,*) '         2nd order scheme is used' 
     176         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is usedi, k-j-i case' 
     177         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used' 
     178         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used' 
     179         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used' 
     180         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used' 
     181         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme' 
    187182      ENDIF 
    188       IF(lwp) WRITE(numout,*) '             choice of tra_adv_...                nadv   = ', nadv 
    189  
     183      ! 
    190184   END SUBROUTINE tra_adv_ctl 
    191185 

  • trunk/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r457 r503  
    44   !! Ocean active tracers:  horizontal & vertical advective trend 
    55   !!============================================================================== 
    6    !! History : 
    7    !!   8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad = traadv  
    8    !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    9    !!   9.0  !  04-08  (C. Talandier) New trends organization 
    10    !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization 
    11    !!    "   !  06-04  (R. Benshila, G. Madec) Step reorganization 
     6   !! History :  8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad = traadv  
     7   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     8   !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
     9   !!            " "  !  06-04  (R. Benshila, G. Madec) Step reorganization 
     10   !!---------------------------------------------------------------------- 
     11 
    1212   !!---------------------------------------------------------------------- 
    1313   !!   tra_adv_cen2 : update the tracer trend with the horizontal and 
    … …  
    1515   !!                  centered scheme. (k-j-i loops) 
    1616   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1817   USE oce             ! ocean dynamics and active tracers 
    1918   USE dom_oce         ! ocean space and time domain 
    … …  
    3332   PRIVATE 
    3433 
    35    !! * Accessibility 
    36    PUBLIC tra_adv_cen2    ! routine called by step.F90 
     34   PUBLIC   tra_adv_cen2   ! routine called by step.F90 
     35 
     36   REAL(wp), DIMENSION(jpi,jpj) ::   btr2   ! inverse of T-point surface [1/(e1t*e2t)] 
    3737 
    3838   !! * Substitutions 
    … …  
    4242   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    4343   !! $Header$  
    44    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     44   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
    4646 
    … …  
    8686      !!         zta+tn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u  un  di[tn] ) 
    8787      !!                                      +mj-1( e1v*e3v  vn  mj[tn] )  } 
    88       !!         C A U T I O N : the trend saved is the centered trend only. 
    89       !!      It doesn't take into account the upstream part of the scheme. 
    9088      !!         NB:in z-coordinate - full step (ln_zco=T) e3u=e3v=e3t, so 
    9189      !!      they vanish from the expression of the flux and divergence. 
    … …  
    110108      !! 
    111109      !! ** Action :  - update (ta,sa) with the now advective tracer trends 
    112       !!              - save trends in (ttrdh,ttrd,strdhi,strd) ('key_trdtra') 
    113       !! 
     110      !!              - save trends in (ztrdt,ztrds) ('key_trdtra') 
    114111      !!---------------------------------------------------------------------- 
    115       !! * Modules used 
    116       USE oce                , zwx => ua,  &  ! use ua as workspace 
    117          &                     zwy => va      ! use va as workspace 
    118  
    119       !! * Arguments 
    120       INTEGER , INTENT( in ) ::   kt          ! ocean time-step index 
    121       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj,jpk) ::   & 
    122          pun, pvn, pwn                        ! now ocean velocity fields 
    123   
    124       !! * Local save 
    125       REAL(wp), DIMENSION(jpi,jpj), SAVE ::   & 
    126          zbtr2 
    127   
    128       !! * Local declarations 
    129       INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
     112      USE oce, ONLY :   zwx => ua   ! use ua as workspace 
     113      USE oce, ONLY :   zwy => va   ! use va as workspace 
     114      !! 
     115      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
     116      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component 
     117      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component 
     118      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component 
     119      !! 
     120      INTEGER  ::   ji, jj, jk                           ! dummy loop indices 
    130121      REAL(wp) ::                           & 
    131122         zbtr, zta, zsa, zfui, zfvj,        &  ! temporary scalars 
    … …  
    135126         zcofk, zupst, zupss, zcent,        &  !    "         " 
    136127         zcens, zfp_w, zfm_w,               &  !    "         " 
    137          zcenut, zcenvt, zcenus, zcenvs        !    "         " 
    138       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    139          zwz, zww, zind,                    &  ! temporary workspace arrays 
    140          ztdta, ztdsa                          !    "         " 
     128         zcenut, zcenvt, zcenus, zcenvs,    &  !    "         " 
     129         z_hdivn_x, z_hdivn_y, z_hdivn 
     130      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace  
     131      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww, ztrds         !  "      " 
    141132      !!---------------------------------------------------------------------- 
    142133 
    … …  
    146137         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case' 
    147138         IF(lwp) WRITE(numout,*) 
    148     
    149          zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    150       ENDIF 
    151  
    152       ! Save ta and sa trends 
    153       IF( l_trdtra )   THEN 
    154          ztdta(:,:,:) = ta(:,:,:)  
    155          ztdsa(:,:,:) = sa(:,:,:)  
    156          l_adv = 'ce2' 
     139         !  
     140         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    157141      ENDIF 
    158142 
    159143      ! Upstream / centered scheme indicator 
    160144      ! ------------------------------------ 
    161   
    162145      DO jk = 1, jpk 
    163146         DO jj = 1, jpj 
    … …  
    176159 
    177160 
    178       ! I. Horizontal advective fluxes 
    179       ! ------------------------------ 
    180  
    181       ! 1. Second order centered tracer flux at u and v-points 
    182       ! ------------------------------------------------------- 
    183  
     161      !  Horizontal advective fluxes 
     162      ! ----------------------------- 
    184163      !                                                ! =============== 
    185164      DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    220199         END DO 
    221200 
    222          ! 2. Tracer flux divergence at t-point added to the general trend 
    223          ! --------------------------------------------------------------- 
    224  
     201         !  Tracer flux divergence at t-point added to the general trend 
     202         ! -------------------------------------------------------------- 
    225203         DO jj = 2, jpjm1 
    226204            DO ji = fs_2, fs_jpim1   ! vector opt. 
    227205#if defined key_zco 
    228                zbtr = zbtr2(ji,jj) 
    229 #else 
    230                zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
     206               zbtr = btr2(ji,jj) 
     207#else 
     208               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk) 
    231209#endif 
    232210               ! horizontal advective trends 
    … …  
    244222      !                                                ! =============== 
    245223 
    246       ! 3. Save the horizontal advective trends for diagnostic 
    247       ! ------------------------------------------------------ 
    248       IF( l_trdtra )   THEN 
    249          ! Recompute the hoizontal advection zta & zsa trends computed  
    250          ! at the step 2. above in making the difference between the new  
    251          ! trends and the previous one ta()/sa - ztdta()/ztdsa() and add 
    252          ! the term tn()/sn()*hdivn() to recover the Uh gradh(T/S) trends 
    253          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) + tn(:,:,:) * hdivn(:,:,:)  
    254          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) + sn(:,:,:) * hdivn(:,:,:) 
    255  
    256          CALL trd_mod(ztdta, ztdsa, jpttdlad, 'TRA', kt) 
    257  
    258          ! Save the new ta and sa trends 
    259          ztdta(:,:,:) = ta(:,:,:)  
    260          ztdsa(:,:,:) = sa(:,:,:)  
    261  
     224      !  Save the horizontal advective trends for diagnostic 
     225      ! ----------------------------------------------------- 
     226      IF( l_trdtra ) THEN 
     227         ! T/S ZONAL advection trends 
     228         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
     229         ! 
     230         DO jk = 1, jpkm1 
     231            DO jj = 2, jpjm1 
     232               DO ji = fs_2, fs_jpim1   ! vector opt. 
     233                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
     234                  !   N.B. This computation is not valid along OBCs (if any) 
     235#if defined key_zco 
     236                  zbtr      = btr2(ji,jj)  
     237                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              & 
     238                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr 
     239#else 
     240                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk) 
     241                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
     242                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
     243#endif 
     244                  ztrdt(ji,jj,jk) = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x 
     245                  ztrds(ji,jj,jk) = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x 
     246               END DO 
     247            END DO 
     248         END DO 
     249         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt) 
     250         ! 
     251         ! T/S MERIDIONAL advection trends 
     252         DO jk = 1, jpkm1 
     253            DO jj = 2, jpjm1 
     254               DO ji = fs_2, fs_jpim1   ! vector opt. 
     255                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
     256                  !   N.B. This computation is not valid along OBCs (if any) 
     257#if defined key_zco 
     258                  zbtr      = btr2(ji,jj)  
     259                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              & 
     260                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr 
     261#else 
     262                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk) 
     263                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
     264                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
     265#endif 
     266                  ztrdt(ji,jj,jk) = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y           
     267                  ztrds(ji,jj,jk) = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y 
     268               END DO 
     269            END DO 
     270         END DO 
     271         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt) 
     272         ! 
     273         ! Save the horizontal up-to-date ta/sa trends 
     274         ztrdt(:,:,:) = ta(:,:,:)  
     275         ztrds(:,:,:) = sa(:,:,:) 
    262276      ENDIF 
    263277 
    … …  
    265279         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    266280 
    267       ! "zonal" mean advective heat and salt transport 
     281      ! 4. "zonal" mean advective heat and salt transport  
     282      ! ------------------------------------------------- 
     283 
    268284      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    269285         IF( lk_zco ) THEN 
    … …  
    299315      ! 1. Vertical advective fluxes 
    300316      ! ---------------------------- 
    301  
    302317      ! Second order centered tracer flux at w-point 
    303  
    304318      DO jk = 2, jpk 
    305319         DO jj = 2, jpjm1 
    … …  
    324338      END DO 
    325339 
    326  
    327340      ! 2. Tracer flux divergence at t-point added to the general trend 
    328341      ! ------------------------- 
    329    
    330342      DO jk = 1, jpkm1 
    331343         DO jj = 2, jpjm1 
    … …  
    347359         ! Recompute the vertical advection zta & zsa trends computed  
    348360         ! at the step 2. above in making the difference between the new  
    349          ! trends and the previous one: ta()/sa - ztdta()/ztdsa() and substract 
     361         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract 
    350362         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends 
    351          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) - tn(:,:,:) * hdivn(:,:,:)  
    352          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) - sn(:,:,:) * hdivn(:,:,:) 
    353  
    354          CALL trd_mod(ztdta, ztdsa, jpttdzad, 'TRA', kt) 
     363 
     364         DO jk = 1, jpkm1 
     365            DO jj = 2, jpjm1 
     366               DO ji = fs_2, fs_jpim1   ! vector opt. 
     367#if defined key_zco 
     368                  zbtr      = btr2(ji,jj)  
     369                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
     370                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
     371#else 
     372                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk) 
     373                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk) 
     374                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk) 
     375#endif 
     376                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
     377                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn  
     378                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn 
     379               END DO 
     380            END DO 
     381         END DO 
     382         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt) 
    355383      ENDIF 
    356384 
    357385      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 zad  - Ta: ', mask1=tmask, & 
    358386         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    359  
    360  
     387      ! 
    361388   END SUBROUTINE tra_adv_cen2 
    362389 

  • trunk/NEMO/OPA_SRC/TRA/traadv_cen2_jki.F90

    r458 r503  
    44   !! Ocean active tracers:  horizontal & vertical advective trend 
    55   !!============================================================================== 
    6    !! History : 
    7    !!   8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad = traadv 
    8    !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    9    !!   9.0  !  04-08  (C. Talandier) New trends organization 
    10    !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization 
    11    !!    "   !  06-04  (R. Benshila, G. Madec) Step reorganization 
     6   !! History :  8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad = traadv 
     7   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     8   !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
     9   !!            " "  !  06-04  (R. Benshila, G. Madec) Step reorganization 
     10   !!---------------------------------------------------------------------- 
     11 
    1212   !!---------------------------------------------------------------------- 
    1313   !!   tra_adv_cen2_jki : update the tracer trend with the horizontal and 
    … …  
    1616   !!                  hor. adv., j-slab for vert. adv. (j-k-i loops) 
    1717   !!---------------------------------------------------------------------- 
    18    !! * Modules used 
    1918   USE oce             ! ocean dynamics and active tracers 
    2019   USE dom_oce         ! ocean space and time domain 
    … …  
    3433   PRIVATE 
    3534 
    36    !! * Accessibility 
    37    PUBLIC tra_adv_cen2_jki    ! routine called by step.F90 
     35   PUBLIC   tra_adv_cen2_jki   ! routine called by step.F90 
     36 
     37   REAL(wp), DIMENSION(jpi,jpj) ::   btr2   ! inverse of T-point surface [1/(e1t*e2t)] 
    3838 
    3939   !! * Substitutions 
    … …  
    4242   !!---------------------------------------------------------------------- 
    4343   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
     44   !! $Header$  
     45   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4446   !!---------------------------------------------------------------------- 
    4547 
    4648CONTAINS 
    47  
    48    !!---------------------------------------------------------------------- 
    49    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    50    !!---------------------------------------------------------------------- 
    5149 
    5250   SUBROUTINE tra_adv_cen2_jki( kt, pun, pvn, pwn ) 
    … …  
    8987      !!         zta+tn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u  un  di[tn] ) 
    9088      !!                                      +mj-1( e1v*e3v  vn  mj[tn] )  } 
    91       !!         C A U T I O N : the trend saved is the centered trend only. 
    92       !!      It doesn't take into account the upstream part of the scheme. 
    9389      !!         NB:in z-coordinate - full step (ln_zco=T) e3u=e3v=e3t, so  
    9490      !!      they vanish from the expression of the flux and divergence. 
    … …  
    113109      !! 
    114110      !! ** Action :  - update (ta,sa) with the now advective tracer trends 
    115       !!              - save trends in (ttrdh,ttrd,strdhi,strd) ('key_trdtra') 
    116       !! 
     111      !!              - save trends in (ztrdt,ztrds) ('key_trdtra') 
    117112      !!---------------------------------------------------------------------- 
    118       !! * Modules used 
    119       USE oce              , zwx => ua,    &  ! use ua as workspace 
    120          &                   zwy => va        ! use va as workspace 
    121  
    122       !! * Arguments 
    123       INTEGER , INTENT( in ) ::   kt          ! ocean time-step index 
    124       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj,jpk) ::   & 
    125          pun, pvn, pwn                        ! now ocean velocity fields 
    126  
    127       !! * Local save 
    128       REAL(wp), DIMENSION(jpi,jpj), SAVE ::   & 
    129          zbtr2 
    130  
    131       !! * Local declarations 
    132       INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
     113      USE oce, ONLY :   zwx => ua   ! use ua as workspace 
     114      USE oce, ONLY :   zwy => va   ! use va as workspace 
     115      !! 
     116      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
     117      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component 
     118      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component 
     119      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component 
     120      !! 
     121      INTEGER  ::   ji, jj, jk                           ! dummy loop indices 
    133122      REAL(wp) ::                           & 
    134123         zbtr, zta, zsa, zfui, zfvj,        &  ! temporary scalars 
    … …  
    138127         zcofk, zupst, zupss, zcent,        &  !    "         " 
    139128         zcens, zfp_w, zfm_w,               &  !    "         " 
    140          zcenut, zcenvt, zcenus, zcenvs        !    "         " 
    141       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    142          zwz, zww, zind,                    &  ! temporary workspace arrays 
    143          ztdta, ztdsa                          !    "         " 
     129         zcenut, zcenvt, zcenus, zcenvs,    &  !    "         " 
     130         z_hdivn_x, z_hdivn_y, z_hdivn 
     131      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace  
     132      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww, ztrds         !  "      " 
    144133      !!---------------------------------------------------------------------- 
    145134 
    … …  
    149138         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   Auto-tasking case' 
    150139         IF(lwp) WRITE(numout,*) 
    151           
    152          zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    153       ENDIF 
    154  
    155       ! Save ta and sa trends 
    156       IF( l_trdtra )   THEN 
    157          ztdta(:,:,:) = ta(:,:,:)  
    158          ztdsa(:,:,:) = sa(:,:,:)  
    159          l_adv = 'ce2' 
     140         ! 
     141         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    160142      ENDIF 
    161143 
    … …  
    165147      DO jk = 1, jpkm1                                 ! Horizontal slab 
    166148         !                                             ! =============== 
    167  
    168          ! 0. Upstream / centered scheme indicator 
    169          ! --------------------------------------- 
     149         !  Upstream / centered scheme indicator 
     150         ! -------------------------------------- 
    170151         DO jj = 1, jpj 
    171152            DO ji = 1, jpi 
    … …  
    181162         END DO 
    182163 
    183  
    184          ! I. Horizontal advective fluxes 
    185          ! ------------------------------ 
     164         !  Horizontal advective fluxes 
     165         ! ----------------------------- 
    186166         ! Second order centered tracer flux at u and v-points 
    187167         DO jj = 1, jpjm1 
    … …  
    220200         END DO 
    221201 
    222          ! 2. Tracer flux divergence at t-point added to the general trend 
    223          ! --------------------------------------------------------------- 
    224  
     202         ! Tracer flux divergence at t-point added to the general trend 
    225203         DO jj = 2, jpjm1 
    226204            DO ji = fs_2, fs_jpim1   ! vector opt. 
    227205#if defined key_zco 
    228                zbtr = zbtr2(ji,jj)  
    229 #else 
    230                zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
     206               zbtr = btr2(ji,jj)  
     207#else 
     208               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk) 
    231209#endif 
    232210               ! horizontal advective trends 
    … …  
    244222      !                                                ! =============== 
    245223 
    246       ! 3. Save the horizontal advective trends for diagnostic 
    247       ! ------------------------------------------------------ 
     224      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 had  - Ta: ', mask1=tmask,   & 
     225         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     226 
     227      ! Save the horizontal advective trends for diagnostics 
    248228      IF( l_trdtra )   THEN 
    249          ! Recompute the hoizontal advection zta & zsa trends computed  
    250          ! at the step 2. above in making the difference between the new  
    251          ! trends and the previous one ta()/sa - ztdta()/ztdsa() and add 
    252          ! the term tn()/sn()*hdivn() to recover the Uh gradh(T/S) trends 
    253          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) + tn(:,:,:) * hdivn(:,:,:)  
    254          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) + sn(:,:,:) * hdivn(:,:,:) 
    255  
    256          CALL trd_mod(ztdta, ztdsa, jpttdlad, 'TRA', kt) 
    257  
    258          ! Save the new ta and sa trends 
    259          ztdta(:,:,:) = ta(:,:,:)  
    260          ztdsa(:,:,:) = sa(:,:,:)  
    261  
     229         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
     230         ! 
     231         ! T/S ZONAL advection trends 
     232         DO jk = 1, jpkm1 
     233            DO jj = 2, jpjm1 
     234               DO ji = fs_2, fs_jpim1   ! vector opt. 
     235                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
     236                  !   N.B. This computation is not valid along OBCs (if any) 
     237#if defined key_zco 
     238                  zbtr      = btr2(ji,jj)  
     239                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              & 
     240                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr 
     241#else 
     242                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk) 
     243                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
     244                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
     245#endif 
     246                  ztrdt(ji,jj,jk) = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x 
     247                  ztrds(ji,jj,jk) = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x 
     248               END DO 
     249            END DO 
     250         END DO 
     251         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt) 
     252         ! 
     253         ! T/S MERIDIONAL advection trends 
     254         DO jk = 1, jpkm1 
     255            DO jj = 2, jpjm1 
     256               DO ji = fs_2, fs_jpim1   ! vector opt. 
     257                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
     258                  !   N.B. This computation is not valid along OBCs (if any) 
     259#if defined key_zco 
     260                  zbtr      = btr2(ji,jj)  
     261                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              & 
     262                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr 
     263#else 
     264                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk) 
     265                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
     266                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
     267#endif 
     268                  ztrdt(ji,jj,jk) = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y           
     269                  ztrds(ji,jj,jk) = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y 
     270               END DO 
     271            END DO 
     272         END DO 
     273         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt) 
     274         ! 
     275         ! Save the up-to-date ta and sa trends 
     276         ztrdt(:,:,:) = ta(:,:,:)  
     277         ztrds(:,:,:) = sa(:,:,:) 
     278         ! 
    262279      ENDIF 
    263280 
    … …  
    281298      ENDIF 
    282299 
    283       ! II. Vertical advection 
    284       ! ---------------------- 
     300      ! Vertical advection 
     301      ! -------------------- 
    285302!CDIR PARALLEL DO 
    286303!$OMP PARALLEL DO 
    … …  
    300317         ENDIF 
    301318          
    302          ! 1. Vertical advective fluxes 
    303          ! ---------------------------- 
    304          ! Second order centered tracer flux at w-point 
     319         ! Vertical advective fluxes at w-point 
    305320         DO jk = 2, jpk 
    306321            DO ji = 2, jpim1 
    … …  
    323338         END DO 
    324339 
    325          ! 2. Tracer flux divergence at t-point added to the general trend 
    326          ! ------------------------- 
     340         ! Tracer flux divergence at t-point added to the general trend 
    327341         DO jk = 1, jpkm1 
    328342            DO ji = 2, jpim1 
    … …  
    340354      !                                                ! =============== 
    341355 
    342       ! 3. Save the vertical advective trends for diagnostic 
    343       ! ---------------------------------------------------- 
     356      ! Save the vertical advective trends for diagnostic 
    344357      IF( l_trdtra )   THEN 
    345358         ! Recompute the vertical advection zta & zsa trends computed  
    346359         ! at the step 2. above in making the difference between the new  
    347          ! trends and the previous one: ta()/sa - ztdta()/ztdsa() and substract 
     360         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract 
    348361         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends 
    349          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) - tn(:,:,:) * hdivn(:,:,:)  
    350          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) - sn(:,:,:) * hdivn(:,:,:) 
    351  
    352          CALL trd_mod(ztdta, ztdsa, jpttdzad, 'TRA', kt) 
     362         ! 
     363         DO jk = 1, jpkm1 
     364            DO jj = 2, jpjm1 
     365               DO ji = fs_2, fs_jpim1   ! vector opt. 
     366#if defined key_zco 
     367                  zbtr      = btr2(ji,jj)  
     368                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
     369                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
     370#else 
     371                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk) 
     372                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk) 
     373                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk) 
     374#endif 
     375                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
     376                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn  
     377                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn 
     378               END DO 
     379            END DO 
     380         END DO 
     381         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt) 
     382         ! 
    353383      ENDIF 
    354384 
    355       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 zad  - Ta: ', mask1=tmask, & 
     385      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 zad  - Ta: ', mask1=tmask,   & 
    356386         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    357  
     387      ! 
    358388   END SUBROUTINE tra_adv_cen2_jki 
    359389 

  • trunk/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r458 r503  
    11MODULE traadv_eiv 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                    ***  MODULE  traadv_eiv  *** 
    44   !! Ocean active tracers:  advection trend - eddy induced velocity 
    5    !!============================================================================== 
    6    !! History : 
    7    !!   9.0  !  05-11  (G. Madec)  Original code from traldf & zdf _iso 
     5   !!====================================================================== 
     6   !! History :  9.0  !  05-11  (G. Madec)  Original code, from traldf and zdf _iso 
    87   !!---------------------------------------------------------------------- 
    98#if defined key_traldf_eiv   ||   defined key_esopa 
    … …  
    1110   !!   'key_traldf_eiv'                  rotation of the lateral mixing tensor 
    1211   !!---------------------------------------------------------------------- 
     12   !!---------------------------------------------------------------------- 
    1313   !!   tra_ldf_iso : update the tracer trend with the horizontal component 
    1414   !!                 of iso neutral laplacian operator or horizontal  
    1515   !!                 laplacian operator in s-coordinate 
    1616   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1817   USE oce             ! ocean dynamics and tracers variables 
    1918   USE dom_oce         ! ocean space and time domain variables 
    … …  
    2524   PRIVATE 
    2625 
    27    !! * Routine accessibility 
    28    PUBLIC tra_adv_eiv  ! routine called by step.F90 
    29  
     26   PUBLIC   tra_adv_eiv   ! routine called by step.F90 
    3027 
    3128   !! * Substitutions 
    … …  
    3532#  include "vectopt_loop_substitute.h90" 
    3633   !!---------------------------------------------------------------------- 
    37    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     34   !!  OPA 9.0 , LOCEAN-IPSL (2006)  
     35   !! $Header$  
     36   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3837   !!---------------------------------------------------------------------- 
    3938 
    … …  
    5756      !! 
    5857      !! ** Action  : - add to p.n the eiv component 
     58      !!---------------------------------------------------------------------- 
     59      INTEGER , INTENT(in   )                         ::   kt    ! ocean time-step index 
     60      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun   ! in : 3 ocean velocity components  
     61      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pvn   ! out: 3 ocean velocity components 
     62      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pwn   !      increased by the eiv 
    5963      !! 
    60       !!---------------------------------------------------------------------- 
    61       !! * Arguments 
    62       INTEGER , INTENT( in ) ::   kt       ! ocean time-step index 
    63       REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj,jpk) ::   & 
    64          pun, pvn, pwn                     ! in : now ocean velocity fields  
    65          !                                 ! out: fields increased by the eiv components 
    66  
    67       !! * Local declarations 
    68       INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    69       REAL(wp) ::                       & 
    70          zuwk, zuwk1, zuwi, zuwi1,      &  ! temporary scalar 
    71          zvwk, zvwk1, zvwj, zvwj1,      &  ! 
    72          zu_eiv, zv_eiv, zw_eiv            ! 
     64      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
     65      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! temporary scalar 
     66      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !    "         " 
     67      REAL(wp) ::   zu_eiv, zv_eiv, zw_eiv     !    "         " 
    7368      !!---------------------------------------------------------------------- 
    7469 
    … …  
    8378# endif 
    8479      ENDIF 
    85  
    8680      !                                             ! ================= 
    8781      DO jk = 1, jpkm1                              !  Horizontal slab 
    8882         !                                          ! ================= 
    89  
    9083         DO jj = 1, jpjm1 
    9184            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    9588               zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeiv(ji,jj,jk+1) * vmask(ji,jj,jk+1) 
    9689 
    97                zu_eiv =  0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) / fse3u(ji,jj,jk) 
    98                zv_eiv =  0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) / fse3v(ji,jj,jk) 
     90               zu_eiv = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) / fse3u(ji,jj,jk) 
     91               zv_eiv = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) / fse3v(ji,jj,jk) 
    9992    
    10093               pun(ji,jj,jk) = pun(ji,jj,jk) + zu_eiv 
    10194               pvn(ji,jj,jk) = pvn(ji,jj,jk) + zv_eiv 
    102  
    10395# if defined key_diaeiv 
    10496               u_eiv(ji,jj,jk) = zu_eiv 
    … …  
    118110                  zw_eiv = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) / ( e1t(ji,jj)*e2t(ji,jj) ) 
    119111# else 
    120                   zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) ) * e2u(ji-1,jj) * umask(ji-1,jj,jk) 
    121                   zuwk = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) ) * e2u(ji  ,jj) * umask(ji  ,jj,jk) 
    122                   zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) ) * e1v(ji,jj-1) * vmask(ji,jj-1,jk) 
    123                   zvwk = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) ) * e1v(ji  ,jj) * vmask(ji  ,jj,jk) 
     112                  zuwi = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) ) * e2u(ji-1,jj) * umask(ji-1,jj,jk) 
     113                  zuwi1 = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) ) * e2u(ji  ,jj) * umask(ji  ,jj,jk) 
     114                  zvwj = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) ) * e1v(ji,jj-1) * vmask(ji,jj-1,jk) 
     115                  zvwj1 = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) ) * e1v(ji  ,jj) * vmask(ji  ,jj,jk) 
    124116 
    125                   zw_eiv = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwk - zuwki + zvwk - zvwki ) 
     117                  zw_eiv = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj )  & 
    126118                     &                                                / ( e1t(ji,jj)*e2t(ji,jj) ) 
    127119# endif 
    … …  
    137129      END DO                                        !    End of slab   
    138130      !                                             ! ================= 
    139  
    140131   END SUBROUTINE tra_adv_eiv 
    141132 
    … …  
    146137CONTAINS 
    147138   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn )              ! Empty routine 
    148       INTEGER ::   kt  
    149139      REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn 
    150       WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?',   & 
    151          &       kt, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
     140      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
    152141   END SUBROUTINE tra_adv_eiv 
    153142#endif 

  • trunk/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r457 r503  
    11MODULE traadv_muscl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  traadv_muscl  *** 
    44   !! Ocean active tracers:  horizontal & vertical advective trend 
    5    !!============================================================================== 
     5   !!====================================================================== 
     6   !! History :       !  06-00  (A.Estublier)  for passive tracers 
     7   !!                 !  01-08  (E.Durand, G.Madec)  adapted for T & S 
     8   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     9   !!---------------------------------------------------------------------- 
    610 
    711   !!---------------------------------------------------------------------- 
    … …  
    913   !!                   and vertical advection trends using MUSCL scheme 
    1014   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1215   USE oce             ! ocean dynamics and active tracers 
    1316   USE dom_oce         ! ocean space and time domain 
    … …  
    2528   PRIVATE 
    2629 
    27    !! * Accessibility 
    28    PUBLIC tra_adv_muscl  ! routine called by step.F90 
     30   PUBLIC   tra_adv_muscl  ! routine called by step.F90 
    2931 
    3032   !! * Substitutions 
    … …  
    3234#  include "vectopt_loop_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    34    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     36   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    3537   !! $Header$  
    36    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     38   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3739   !!---------------------------------------------------------------------- 
    3840 
    … …  
    5052      !! 
    5153      !! ** Action  : - update (ta,sa) with the now advective tracer trends 
    52       !!              - save trends in (ztdta,ztdsa) ('key_trdtra') 
    53       !! 
    54       !! References :                 
    55       !!      Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation 
    56       !! IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    57       !! 
    58       !! History : 
    59       !!        !  06-00  (A.Estublier)  for passive tracers 
    60       !!        !  01-08  (E.Durand G.Madec)  adapted for T & S 
    61       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    62       !!   9.0  !  04-08  (C. Talandier) New trends organization 
     54      !!              - save trends in (ztrdt,ztrds) ('key_trdtra') 
     55      !! 
     56      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation 
     57      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    6358      !!---------------------------------------------------------------------- 
    64       !! * Arguments 
    65       INTEGER , INTENT( in ) ::   kt          ! ocean time-step index 
    66       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj,jpk) ::   & 
    67          pun, pvn, pwn                        ! now ocean velocity fields 
    68  
    69       !! * Local declarations 
    70       INTEGER ::   ji, jj, jk               ! dummy loop indices 
     59      USE oce, ONLY :   ztrdt => ua   ! use ua as workspace 
     60      USE oce, ONLY :   ztrds => va   ! use va as workspace 
     61      !! 
     62      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
     63      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component 
     64      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component 
     65      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component 
     66      !! 
     67      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    7168      REAL(wp) ::   & 
    7269         zu, zv, zw, zeu, zev,           &   
    … …  
    7572         zzt1, zzt2, zalpha,             & 
    7673         zzs1, zzs2, z2,                 & 
    77          zta, zsa                           
    78       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   & 
    79          zt1, zt2, ztp1, ztp2,               & 
    80          zs1, zs2, zsp1, zsp2,               & 
    81          ztdta, ztdsa 
     74         zta, zsa,                       & 
     75        z_hdivn_x, z_hdivn_y, z_hdivn 
     76      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zt1, zt2, ztp1, ztp2   ! 3D workspace 
     77      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zs1, zs2, zsp1, zsp2   !  "      " 
    8278      !!---------------------------------------------------------------------- 
    8379 
    … …  
    8884      ENDIF 
    8985 
    90       IF( neuler == 0 .AND. kt == nit000 ) THEN 
    91           z2=1. 
    92       ELSE 
    93           z2=2. 
    94       ENDIF 
    95  
    96       ! Save ta and sa trends 
    97       IF( l_trdtra )   THEN 
    98          ztdta(:,:,:) = ta(:,:,:)  
    99          ztdsa(:,:,:) = sa(:,:,:)  
    100          l_adv = 'mus' 
    101       ENDIF 
    102  
     86      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2 = 1. 
     87      ELSE                                        ;    z2 = 2. 
     88      ENDIF 
    10389 
    10490      ! I. Horizontal advective fluxes 
    10591      ! ------------------------------ 
    106  
    10792      ! first guess of the slopes 
    10893      ! interior values 
    … …  
    193178               zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 ) 
    194179               zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 ) 
    195  
     180               ! 
    196181               z0v = SIGN( 0.5, pvn(ji,jj,jk) )             
    197182               zalpha = 0.5 - z0v 
    … …  
    211196      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. ) 
    212197 
    213       ! Save MUSCL fluxes to compute i- & j- horizontal  
    214       ! advection trends in the MLD 
    215       IF( l_trdtra )   THEN 
    216          ! save i- terms 
    217          tladi(:,:,:) = zt1(:,:,:)  
    218          sladi(:,:,:) = zs1(:,:,:)  
    219          ! save j- terms 
    220          tladj(:,:,:) = zt2(:,:,:)  
    221          sladj(:,:,:) = zs2(:,:,:)  
    222       ENDIF 
    223  
    224       ! Compute & add the horizontal advective trend 
    225  
     198      ! Tracer flux divergence at t-point added to the general trend 
    226199      DO jk = 1, jpkm1 
    227200         DO jj = 2, jpjm1       
    … …  
    244217      END DO         
    245218 
    246       ! Save the horizontal advective trends for diagnostic 
    247  
    248       IF( l_trdtra )   THEN 
    249          ! Recompute the horizontal advection zta & zsa trends computed  
    250          ! at the step 2. above in making the difference between the new  
    251          ! trends and the previous one ta()/sa - ztdta()/ztdsa() and add 
    252          ! the term tn()/sn()*hdivn() to recover the Uh gradh(T/S) trends 
    253          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) + tn(:,:,:) * hdivn(:,:,:)  
    254          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) + sn(:,:,:) * hdivn(:,:,:) 
    255  
    256          CALL trd_mod(ztdta, ztdsa, jpttdlad, 'TRA', kt) 
    257  
    258          ! Save the new ta and sa trends 
    259          ztdta(:,:,:) = ta(:,:,:)  
    260          ztdsa(:,:,:) = sa(:,:,:)  
    261  
    262       ENDIF 
    263  
    264       IF(ln_ctl) THEN 
    265          CALL prt_ctl(tab3d_1=ta, clinfo1=' muscl had  - Ta: ', mask1=tmask ,  & 
    266             &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra' ) 
     219      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl had  - Ta: ', mask1=tmask ,  & 
     220         &                       tab3d_2=sa, clinfo2=             ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     221 
     222      ! Save the horizontal advective trends for diagnostics 
     223      IF( l_trdtra ) THEN 
     224         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
     225         ! 
     226         ! T/S ZONAL advection trends 
     227         DO jk = 1, jpkm1 
     228            DO jj = 2, jpjm1 
     229               DO ji = fs_2, fs_jpim1   ! vector opt. 
     230                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
     231                  !   N.B. This computation is not valid along OBCs (if any) 
     232#if defined key_zco 
     233                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     234                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              & 
     235                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr 
     236#else 
     237                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     238                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
     239                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
     240#endif 
     241                  ztrdt(ji,jj,jk) = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x 
     242                  ztrds(ji,jj,jk) = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x 
     243               END DO 
     244            END DO 
     245         END DO 
     246         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt) 
     247 
     248         ! T/S MERIDIONAL advection trends 
     249         DO jk = 1, jpkm1 
     250            DO jj = 2, jpjm1 
     251               DO ji = fs_2, fs_jpim1   ! vector opt. 
     252                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
     253                  !   N.B. This computation is not valid along OBCs (if any) 
     254#if defined key_zco 
     255                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     256                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              & 
     257                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr 
     258#else 
     259                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     260                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
     261                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
     262#endif 
     263                  ztrdt(ji,jj,jk) = - zbtr * ( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y           
     264                  ztrds(ji,jj,jk) = - zbtr * ( zs2(ji,jj,jk) - zs2(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y 
     265               END DO 
     266            END DO 
     267         END DO 
     268         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt) 
     269 
     270         ! Save the up-to-date ta and sa trends 
     271         ztrdt(:,:,:) = ta(:,:,:)  
     272         ztrds(:,:,:) = sa(:,:,:)  
     273         ! 
    267274      ENDIF 
    268275 
    … …  
    378385 
    379386      ! Save the vertical advective trends for diagnostic 
    380  
     387      ! ------------------------------------------------- 
    381388      IF( l_trdtra )   THEN 
    382389         ! Recompute the vertical advection zta & zsa trends computed  
    383390         ! at the step 2. above in making the difference between the new  
    384          ! trends and the previous one: ta()/sa - ztdta()/ztdsa() and substract 
     391         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract 
    385392         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends 
    386          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) - tn(:,:,:) * hdivn(:,:,:)  
    387          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) - sn(:,:,:) * hdivn(:,:,:) 
    388  
    389          CALL trd_mod(ztdta, ztdsa, jpttdzad, 'TRA', kt) 
    390       ENDIF 
    391  
    392       IF(ln_ctl) THEN 
    393          CALL prt_ctl(tab3d_1=ta, clinfo1=' muscl zad  - Ta: ', mask1=tmask ,  & 
    394             &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    395       ENDIF 
    396  
     393 
     394         DO jk = 1, jpkm1 
     395            DO jj = 2, jpjm1 
     396               DO ji = fs_2, fs_jpim1   ! vector opt. 
     397#if defined key_zco 
     398                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     399                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
     400                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
     401#else 
     402                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     403                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk) 
     404                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk) 
     405#endif 
     406                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
     407                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn  
     408                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn 
     409               END DO 
     410            END DO 
     411         END DO 
     412         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt) 
     413         ! 
     414      ENDIF 
     415 
     416      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl zad  - Ta: ', mask1=tmask ,   & 
     417         &                       tab3d_2=sa, clinfo2=             ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     418      ! 
    397419   END SUBROUTINE tra_adv_muscl 
    398420 

  • trunk/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r457 r503  
    44   !! Ocean active tracers:  horizontal & vertical advective trend 
    55   !!============================================================================== 
     6   !! History :  9.0  !  02-06  (G. Madec) from traadv_muscl 
     7   !!---------------------------------------------------------------------- 
    68 
    79   !!---------------------------------------------------------------------- 
    … …  
    911   !!                    and vertical advection trends using MUSCL2 scheme 
    1012   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1213   USE oce             ! ocean dynamics and active tracers 
    1314   USE dom_oce         ! ocean space and time domain 
    … …  
    3233#  include "vectopt_loop_substitute.h90" 
    3334   !!---------------------------------------------------------------------- 
    34    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     35   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    3536   !! $Header$  
    36    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     37   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3738   !!---------------------------------------------------------------------- 
    3839 
    … …  
    5051      !! 
    5152      !! ** Action  : - update (ta,sa) with the now advective tracer trends 
    52       !!              - save trends in (ztdta,ztdsa) ('key_trdtra') 
    53       !! 
    54       !! References :                 
    55       !!      Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation 
    56       !! IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    57       !! 
    58       !! History : 
    59       !!        !  06-00  (A.Estublier)  for passive tracers 
    60       !!        !  01-08  (E.Durand G.Madec)  adapted for T & S 
    61       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    62       !!   9.0  !  04-08  (C. Talandier) New trends organization 
     53      !!              - save trends in (ztrdt,ztrds) ('key_trdtra') 
     54      !! 
     55      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation 
     56      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    6357      !!---------------------------------------------------------------------- 
    64       !! * Arguments 
    65       INTEGER , INTENT( in ) ::   kt          ! ocean time-step index 
    66       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj,jpk) ::   & 
    67          pun, pvn, pwn                        ! now ocean velocity fields 
    68  
    69  
    70       !! * Local declarations 
    71       INTEGER ::   ji, jj, jk               ! dummy loop indices 
     58      USE oce              , ztrdt => ua   ! use ua as workspace 
     59      USE oce              , ztrds => va   ! use va as workspace 
     60      !! 
     61      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
     62      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component 
     63      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component 
     64      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component 
     65      !! 
     66      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    7267      REAL(wp) ::   & 
    7368         zu, zv, zw, zeu, zev,           &   
    … …  
    7671         zzt1, zzt2, zalpha,             & 
    7772         zzs1, zzs2, z2,                 & 
    78          zta, zsa 
    79       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   & 
    80          zt1, zt2, ztp1, ztp2,   & 
    81          zs1, zs2, zsp1, zsp2,   & 
    82          ztdta, ztdsa 
     73         zta, zsa,                       & 
     74         z_hdivn_x, z_hdivn_y, z_hdivn 
     75      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zt1, zt2, ztp1, ztp2   ! 3D workspace 
     76      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zs1, zs2, zsp1, zsp2   !  "      " 
    8377      !!---------------------------------------------------------------------- 
    8478 
    … …  
    8983      ENDIF 
    9084 
    91       IF( neuler == 0 .AND. kt == nit000 ) THEN 
    92           z2=1. 
    93       ELSE 
    94           z2=2. 
    95       ENDIF 
    96  
    97       ! Save ta and sa trends 
    98       IF( l_trdtra )   THEN 
    99          ztdta(:,:,:) = ta(:,:,:)  
    100          ztdsa(:,:,:) = sa(:,:,:)  
    101          l_adv = 'mu2' 
    102       ENDIF 
    103  
     85      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2 = 1. 
     86      ELSE                                        ;   z2 = 2. 
     87      ENDIF 
    10488 
    10589      ! I. Horizontal advective fluxes 
    … …  
    194178               zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 ) 
    195179               zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 ) 
    196  
     180               ! 
    197181               z0v = SIGN( 0.5, pvn(ji,jj,jk) )             
    198182               zalpha = 0.5 - z0v 
    … …  
    271255      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. ) 
    272256 
    273       ! Save MUSCL fluxes to compute i- & j- horizontal  
    274       ! advection trends in the MLD 
    275       IF( l_trdtra )   THEN 
    276          ! save i- terms 
    277          tladi(:,:,:) = zt1(:,:,:)  
    278          sladi(:,:,:) = zs1(:,:,:)  
    279          ! save j- terms 
    280          tladj(:,:,:) = zt2(:,:,:)  
    281          sladj(:,:,:) = zs2(:,:,:)  
    282       ENDIF 
    283  
    284257      ! Compute & add the horizontal advective trend 
    285258 
    … …  
    305278 
    306279      ! Save the horizontal advective trends for diagnostic 
    307  
    308       IF( l_trdtra )   THEN 
    309          ! Recompute the horizontal advection zta & zsa trends computed  
    310          ! at the step 2. above in making the difference between the new  
    311          ! trends and the previous one ta()/sa - ztdta()/ztdsa() and add 
    312          ! the term tn()/sn()*hdivn() to recover the Uh gradh(T/S) trends 
    313          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) + tn(:,:,:) * hdivn(:,:,:)  
    314          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) + sn(:,:,:) * hdivn(:,:,:) 
    315  
    316          CALL trd_mod(ztdta, ztdsa, jpttdlad, 'TRA', kt) 
    317  
    318          ! Save the new ta and sa trends 
    319          ztdta(:,:,:) = ta(:,:,:)  
    320          ztdsa(:,:,:) = sa(:,:,:)  
    321  
    322       ENDIF 
    323  
    324       IF(ln_ctl) THEN 
    325          CALL prt_ctl(tab3d_1=ta, clinfo1=' muscl2 had  - Ta: ', mask1=tmask, & 
    326             &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    327       ENDIF 
     280      IF( l_trdtra ) THEN 
     281         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
     282         ! 
     283         ! T/S ZONAL advection trends 
     284         DO jk = 1, jpkm1 
     285            DO jj = 2, jpjm1 
     286               DO ji = fs_2, fs_jpim1   ! vector opt. 
     287                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
     288                  !   N.B. This computation is not valid along OBCs (if any) 
     289#if defined key_zco 
     290                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     291                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              & 
     292                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr 
     293#else 
     294                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     295                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
     296                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
     297#endif 
     298                  ztrdt(ji,jj,jk) = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x 
     299                  ztrds(ji,jj,jk) = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x 
     300               END DO 
     301            END DO 
     302         END DO 
     303         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt) 
     304 
     305         ! T/S MERIDIONAL advection trends 
     306         DO jk = 1, jpkm1 
     307            DO jj = 2, jpjm1 
     308               DO ji = fs_2, fs_jpim1   ! vector opt. 
     309                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
     310                  !   N.B. This computation is not valid along OBCs (if any) 
     311#if defined key_zco 
     312                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     313                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              & 
     314                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr 
     315#else 
     316                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     317                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
     318                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
     319#endif 
     320                  ztrdt(ji,jj,jk) = - zbtr * ( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y           
     321                  ztrds(ji,jj,jk) = - zbtr * ( zs2(ji,jj,jk) - zs2(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y 
     322               END DO 
     323            END DO 
     324         END DO 
     325         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt) 
     326 
     327         ! Save the up-to-date ta and sa trends 
     328         ztrdt(:,:,:) = ta(:,:,:)  
     329         ztrds(:,:,:) = sa(:,:,:)  
     330         ! 
     331      ENDIF 
     332 
     333      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl2 had  - Ta: ', mask1=tmask,   & 
     334         &                       tab3d_2=sa, clinfo2=              ' Sa: ', mask2=tmask, clinfo3='tra') 
    328335 
    329336      ! "zonal" mean advective heat and salt transport 
    … …  
    451458 
    452459      ! Save the vertical advective trends for diagnostic 
    453  
    454460      IF( l_trdtra )   THEN 
    455461         ! Recompute the vertical advection zta & zsa trends computed  
    456462         ! at the step 2. above in making the difference between the new  
    457          ! trends and the previous one: ta()/sa - ztdta()/ztdsa() and substract 
     463         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract 
    458464         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends 
    459          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) - tn(:,:,:) * hdivn(:,:,:)  
    460          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) - sn(:,:,:) * hdivn(:,:,:) 
    461  
    462          CALL trd_mod(ztdta, ztdsa, jpttdzad, 'TRA', kt) 
    463       ENDIF 
    464  
    465       IF(ln_ctl) THEN 
    466          CALL prt_ctl(tab3d_1=ta, clinfo1=' muscl2 zad  - Ta: ', mask1=tmask, & 
    467             &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    468  
    469       ENDIF 
    470  
     465 
     466         DO jk = 1, jpkm1 
     467            DO jj = 2, jpjm1 
     468               DO ji = fs_2, fs_jpim1   ! vector opt. 
     469#if defined key_zco 
     470                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     471                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
     472                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
     473#else 
     474                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     475                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk) 
     476                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk) 
     477#endif 
     478                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
     479                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn  
     480                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn 
     481               END DO 
     482            END DO 
     483         END DO 
     484         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt) 
     485         ! 
     486      ENDIF 
     487 
     488      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl2 zad  - Ta: ', mask1=tmask,   & 
     489         &                       tab3d_2=sa, clinfo2=              ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     490      ! 
    471491   END SUBROUTINE tra_adv_muscl2 
    472492 

  • trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r457 r503  
    44   !! Ocean active tracers:  horizontal & vertical advective trend 
    55   !!============================================================================== 
     6   !! History :       !  95-12  (L. Mortier)  Original code 
     7   !!                 !  00-01  (H. Loukos)  adapted to ORCA  
     8   !!                 !  00-10  (MA Foujols E.Kestenare)  include file not routine 
     9   !!                 !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes 
     10   !!                 !  01-07  (E. Durand G. Madec)  adaptation to ORCA config 
     11   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     12   !!            9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 
     13   !!            9.0  !  08-04  (S. Cravatte) add the i-, j- & k- trends computation 
     14   !!            " "  !  05-11  (V. Garnier) Surface pressure gradient organization 
     15   !!---------------------------------------------------------------------- 
     16 
    617 
    718   !!---------------------------------------------------------------------- 
    … …  
    1122   !!                  algorithm  
    1223   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1424   USE oce             ! ocean dynamics and active tracers 
    1525   USE dom_oce         ! ocean space and time domain 
    … …  
    2838   PRIVATE 
    2939 
    30    !! * Accessibility 
    31    PUBLIC tra_adv_tvd    ! routine called by step.F90 
     40   PUBLIC   tra_adv_tvd    ! routine called by step.F90 
    3241 
    3342   !! * Substitutions 
    … …  
    3544#  include "vectopt_loop_substitute.h90" 
    3645   !!---------------------------------------------------------------------- 
    37    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    38    !! $Header$  
    39    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     46   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     47   !! $Header$ 
     48   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4049   !!---------------------------------------------------------------------- 
    4150 
    … …  
    5463      !! 
    5564      !! ** Action : - update (ta,sa) with the now advective tracer trends 
    56       !!             - save the trends in (ttrdh,strdh) ('key_trdtra') 
     65      !!             - save the trends in (ztrdt,ztrds) ('key_trdtra') 
     66      !!---------------------------------------------------------------------- 
     67      USE oce              , ztrdt => ua   ! use ua as workspace 
     68      USE oce              , ztrds => va   ! use va as workspace 
    5769      !! 
    58       !! History : 
    59       !!        !  95-12  (L. Mortier)  Original code 
    60       !!        !  00-01  (H. Loukos)  adapted to ORCA  
    61       !!        !  00-10  (MA Foujols E.Kestenare)  include file not routine 
    62       !!        !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes 
    63       !!        !  01-07  (E. Durand G. Madec)  adaptation to ORCA config 
    64       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    65       !!   9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 
    66       !!   9.0  !  08-04  (S. Cravatte) add the i-, j- & k- trends computation 
    67       !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization 
    68       !!---------------------------------------------------------------------- 
    69       !! * Modules used 
    70       USE trdmod_oce         , ztay => tladj,  &  ! use tladj latter 
    71          &                     zsay => sladj,  &  ! use sladj latter 
    72          &                     ztaz => tladi,  &  ! use ua as workspace 
    73          &                     zsaz => sladi      ! use ua as workspace 
    74  
    75       !! * Arguments 
    76       INTEGER , INTENT( in ) ::   kt          ! ocean time-step index 
    77       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj,jpk) ::   & 
    78          pun, pvn, pwn                        ! now ocean velocity fields 
    79  
    80       !! * Local declarations 
     70      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
     71      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component 
     72      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component 
     73      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component 
     74      !! 
    8175      INTEGER  ::   ji, jj, jk              ! dummy loop indices 
    8276      REAL(wp) ::                        &  ! temporary scalar 
    8377         ztai, ztaj, ztak,               &  !    "         "    
    84          zsai, zsaj, zsak                   !    "         "    
    85       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   & 
    86          zti, ztu, ztv, ztw,             &  ! temporary workspace 
    87          zsi, zsu, zsv, zsw,             &  !    "           " 
    88          ztdta, ztdsa                       !    "           " 
     78         zsai, zsaj, zsak,               &  !    "         "    
     79         z_hdivn_x, z_hdivn_y, z_hdivn 
    8980      REAL(wp) ::   & 
    90          z2dtt, zbtr, zeu, zev, zew, z2, &  ! temporary scalar 
     81         z2dtt, zbtr, zeu, zev,          &  ! temporary scalar 
     82         zew, z2, zbtr1,                 &  ! temporary scalar 
    9183         zfp_ui, zfp_vj, zfp_wk,         &  !    "         " 
    9284         zfm_ui, zfm_vj, zfm_wk             !    "         " 
     85      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zti, ztu, ztv, ztw   ! temporary workspace 
     86      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zsi, zsu, zsv, zsw   !    "           " 
    9387      !!---------------------------------------------------------------------- 
    9488 
    … …  
    10195      ENDIF 
    10296 
    103       IF( neuler == 0 .AND. kt == nit000 ) THEN 
    104          z2=1. 
    105       ELSE 
    106          z2=2. 
     97      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2 = 1. 
     98      ELSE                                        ;    z2 = 2. 
    10799      ENDIF 
    108  
    109       ! Save ta and sa trends 
    110       IF( l_trdtra )   THEN 
    111          ztdta(:,:,:) = ta(:,:,:)  
    112          ztdsa(:,:,:) = sa(:,:,:)  
    113          l_adv = 'tvd' 
    114       ENDIF 
    115  
    116100 
    117101      ! 1. Bottom value : flux set to zero 
    … …  
    177161            DO ji = fs_2, fs_jpim1   ! vector opt. 
    178162               zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    179  
    180163               ! i- j- horizontal & k- vertical advective trends 
    181164               ztai = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  ) ) * zbtr 
    … …  
    185168               zsaj = - ( zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  ) ) * zbtr 
    186169               zsak = - ( zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr 
    187  
    188170               ! total intermediate advective trends 
    189171               zti(ji,jj,jk) = ztai + ztaj + ztak 
    … …  
    193175      END DO 
    194176 
    195      ! Save the intermediate vertical & j- horizontal advection trends 
    196      IF( l_trdtra )   THEN 
     177 
     178      ! Save the intermediate i / j / k advective trends for diagnostics 
     179      ! ------------------------------------------------------------------- 
     180      ! Warning : We should use zun instead of un in the computations below, but we 
     181      ! also use hdivn which is computed with un, vn (check ???). So we use un, vn 
     182      ! for consistency. Results are therefore approximate with key_trabbl_adv. 
     183 
     184      IF( l_trdtra ) THEN 
     185         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
     186         !  
     187         ! T/S ZONAL advection trends 
    197188         DO jk = 1, jpkm1 
    198189            DO jj = 2, jpjm1 
    199190               DO ji = fs_2, fs_jpim1   ! vector opt. 
    200                   zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    201                   ztay(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  ) ) * zbtr 
    202                   zsay(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  ) ) * zbtr 
    203                   ztaz(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr 
    204                   zsaz(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr 
     191                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     192                  ztrdt(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr 
     193                  ztrds(ji,jj,jk) = - ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) ) * zbtr 
    205194               END DO 
    206195            END DO 
    207196         END DO 
     197         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)    ! save the trends 
     198         ! 
     199         ! T/S MERIDIONAL advection trends 
     200         DO jk = 1, jpkm1 
     201            DO jj = 2, jpjm1 
     202               DO ji = fs_2, fs_jpim1   ! vector opt. 
     203                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     204                  ztrdt(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr 
     205                  ztrds(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) * zbtr 
     206               END DO 
     207            END DO 
     208         END DO 
     209         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)     ! save the trends 
     210         ! 
     211         ! T/S VERTICAL advection trends 
     212         DO jk = 1, jpkm1 
     213            DO jj = 2, jpjm1 
     214               DO ji = fs_2, fs_jpim1   ! vector opt.          
     215                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     216                  ztrdt(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr 
     217                  ztrds(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr 
     218               END DO 
     219            END DO 
     220         END DO 
     221         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)     ! save the trends 
     222         ! 
    208223      ENDIF 
    209224 
    … …  
    244259      ! antidiffusive flux on k 
    245260      ! Surface value 
    246       ztw(:,:,1) = 0. 
    247       zsw(:,:,1) = 0. 
     261      ztw(:,:,1) = 0.e0 
     262      zsw(:,:,1) = 0.e0 
    248263 
    249264      ! Interior value 
    … …  
    290305      END DO 
    291306 
    292       ! save the advective trends for diagnostic 
    293       ! tracers trends 
    294       IF( l_trdtra )   THEN 
    295          ! Compute the final vertical & j- horizontal advection trends 
     307 
     308      ! Save the advective trends for diagnostics 
     309      ! -------------------------------------------- 
     310 
     311      IF( l_trdtra ) THEN 
     312         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
     313         ! 
     314         ! T/S ZONAL advection trends 
    296315         DO jk = 1, jpkm1 
    297316            DO jj = 2, jpjm1 
    298317               DO ji = fs_2, fs_jpim1   ! vector opt. 
    299                   zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    300                   ztay(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  ) ) * zbtr   & 
    301                      &             + ztay(ji,jj,jk)  
    302                   zsay(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  ) ) * zbtr   & 
    303                      &             + zsay(ji,jj,jk)  
    304                   ztaz(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr   & 
    305                      &             + ztaz(ji,jj,jk)  
    306                   zsaz(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr   & 
    307                      &             + zsaz(ji,jj,jk)  
     318                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
     319                  !   N.B. This computation is not valid along OBCs (if any) 
     320                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     321                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
     322                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
     323                  !-- Compute T/S zonal advection trends 
     324                  ztrdt(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_x 
     325                  ztrds(ji,jj,jk) = - ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_x 
    308326               END DO 
    309327            END DO 
    310328         END DO 
    311  
    312          ! horizontal advection:  
    313          ! make the difference between the new trends ta()/sa() and the  
    314          ! previous one ztdta()/ztdsa() to have the total advection trends  
    315          ! to which we substract the vertical trends ztaz()/zsaz() 
    316          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) - ztaz(:,:,:) 
    317          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) - zsaz(:,:,:) 
    318  
    319          ! Add the term tn()/sn()*hdivn() to recover the Uh gradh(T/S) trends 
    320          ztdta(:,:,:) = ztdta(:,:,:) + tn(:,:,:) * hdivn(:,:,:) 
    321          ztdsa(:,:,:) = ztdsa(:,:,:) + sn(:,:,:) * hdivn(:,:,:) 
    322  
    323          CALL trd_mod(ztdta, ztdsa, jpttdlad, 'TRA', kt) 
    324  
    325          ! vertical advection:  
    326          ! Substract the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends 
    327          ztaz(:,:,:) = ztaz(:,:,:) - tn(:,:,:) * hdivn(:,:,:) 
    328          zsaz(:,:,:) = zsaz(:,:,:) - sn(:,:,:) * hdivn(:,:,:) 
    329  
    330          CALL trd_mod(ztaz, zsaz, jpttdzad, 'TRA', kt) 
    331  
     329         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED 
     330         ! 
     331         ! T/S MERIDIONAL advection trends 
     332         DO jk = 1, jpkm1 
     333            DO jj = 2, jpjm1 
     334               DO ji = fs_2, fs_jpim1   ! vector opt. 
     335                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
     336                  !   N.B. This computation is not valid along OBCs (if any) 
     337                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     338                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
     339                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
     340                  !-- Compute T/S meridional advection trends 
     341                  ztrdt(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_y           
     342                  ztrds(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_y           
     343               END DO 
     344            END DO 
     345         END DO 
     346         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED 
     347         ! 
     348         ! T/S VERTICAL advection trends 
     349         DO jk = 1, jpkm1 
     350            DO jj = 2, jpjm1 
     351               DO ji = fs_2, fs_jpim1   ! vector opt. 
     352                  zbtr1     = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     353#if defined key_zco 
     354                  zbtr      = zbtr1 
     355                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
     356                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
     357#else 
     358                  zbtr      = zbtr1 / fse3t(ji,jj,jk) 
     359                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk) 
     360                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk) 
     361#endif 
     362                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
     363                  zbtr      = zbtr1 / fse3t(ji,jj,jk) 
     364                  ztrdt(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr - tn(ji,jj,jk) * z_hdivn 
     365                  ztrds(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr - sn(ji,jj,jk) * z_hdivn 
     366               END DO 
     367            END DO 
     368         END DO 
     369         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED 
     370         ! 
    332371      ENDIF 
    333372 
    334       IF(ln_ctl) THEN 
    335          CALL prt_ctl(tab3d_1=ta, clinfo1=' tvd adv  - Ta: ', mask1=tmask, & 
    336             &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    337       ENDIF 
     373      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' tvd adv  - Ta: ', mask1=tmask,   & 
     374         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    338375 
    339376      ! "zonal" mean advective heat and salt transport 
    … …  
    342379         pst_adv(:) = ptr_vj( zsv(:,:,:) ) 
    343380      ENDIF 
    344  
     381      ! 
    345382   END SUBROUTINE tra_adv_tvd 
    346383 
    … …  
    358395      !!       drange (1995) multi-dimensional forward-in-time and upstream- 
    359396      !!       in-space based differencing for fluid 
    360       !! 
    361       !! History : 
    362       !!        !  97-04  (L. Mortier) Original code 
    363       !!        !  00-02  (H. Loukos)  rewritting for opa8 
    364       !!        !  00-10  (M.A Foujols, E. Kestenare)  lateral b.c. 
    365       !!        !  01-03  (E. Kestenare)  add key_passivetrc 
    366       !!        !  01-07  (E. Durand G. Madec)  adapted for T & S 
    367       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    368397      !!---------------------------------------------------------------------- 
    369       !! * Arguments 
    370       REAL(wp), INTENT( in ) ::   & 
    371          prdt                               ! ??? 
     398      REAL(wp), INTENT( in ) ::   prdt                               ! ??? 
    372399      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( inout ) ::   & 
    373400         pbef,                            & ! before field 
    … …  
    376403         pbb,                             & ! monotonic flux in the j direction 
    377404         pcc                                ! monotonic flux in the k direction 
    378  
    379       !! * Local declarations 
     405      !! 
    380406      INTEGER ::   ji, jj, jk               ! dummy loop indices 
    381407      INTEGER ::   ikm1 
    … …  
    496522      CALL lbc_lnk( pbb, 'V', -1. )      ! changed sign 
    497523      CALL lbc_lnk( pcc, 'W',  1. )      ! NO changed sign 
    498  
     524      ! 
    499525   END SUBROUTINE nonosc 
    500526 

  • trunk/NEMO/OPA_SRC/TRA/trabbc.F90

    r473 r503  
    44   !! Ocean active tracers:  bottom boundary condition 
    55   !!============================================================================== 
     6   !! History :  8.1  ! 99-10 (G. Madec)  original code 
     7   !!            8.5  ! 02-08 (G. Madec)  free form + modules 
     8   !!            8.5  ! 02-11 (A. Bozec)  tra_bbc_init: original code 
     9   !!---------------------------------------------------------------------- 
    610#if   defined key_trabbc   ||   defined key_esopa 
    711   !!---------------------------------------------------------------------- 
    … …  
    1519   USE dom_oce         ! ocean space and time domain 
    1620   USE phycst          ! physical constants 
     21   USE trdmod          ! ocean trends  
     22   USE trdmod_oce      ! ocean variables trends 
    1723   USE in_out_manager  ! I/O manager 
    1824   USE prtctl          ! Print control 
    … …  
    2127   PRIVATE 
    2228 
    23    !! * Accessibility 
    2429   PUBLIC tra_bbc          ! routine called by step.F90 
    2530 
    … …  
    2732   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .TRUE.   !: bbc flag 
    2833 
    29    !! * Module variables 
    30    INTEGER ::                       & !!! ** bbc namelist (nambbc) ** 
    31       ngeo_flux = 1                    ! Geothermal flux (0:no flux, 1:constant flux, 
    32       !                                !                  2:read in file ) 
    33    REAL(wp) ::                      & !!! ** bbc namlist ** 
    34       ngeo_flux_const = 86.4e-3        ! Constant value of geothermal heat flux 
    35  
    36    INTEGER, DIMENSION(jpi,jpj) ::   & 
    37       nbotlevt                         ! ocean bottom level index at T-pt 
    38    REAL(wp), DIMENSION(jpi,jpj) ::  & 
    39       qgh_trd                          ! geothermal heating trend 
     34   !!* Namelist nambbc: bottom boundary condition 
     35   INTEGER  ::   ngeo_flux       = 1            ! Geothermal flux (0:no flux, 1:constant flux, 2:read in file ) 
     36   REAL(wp) ::   ngeo_flux_const = 86.4e-3      ! Constant value of geothermal heat flux 
     37   NAMELIST/nambbc/ngeo_flux, ngeo_flux_const  
     38 
     39   INTEGER , DIMENSION(jpi,jpj) ::   nbotlevt   ! ocean bottom level index at T-pt 
     40   REAL(wp), DIMENSION(jpi,jpj) ::   qgh_trd    ! geothermal heating trend 
    4041  
    4142   !! * Substitutions 
    4243#  include "domzgr_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    44    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     45   !!  OPA 9.0 , LOCEAN-IPSL (2006)  
    4546   !! $Header$  
    46    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     47   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4748   !!---------------------------------------------------------------------- 
    4849 
    … …  
    6869      !!                the ocean bottom boundary condition 
    6970      !! 
    70       !! References : 
    71       !!      Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129. 
    72       !! 
    73       !! History : 
    74       !!   8.1  !  99-10  (G. Madec)  original code 
    75       !!   8.5  !  02-08  (G. Madec)  free form + modules 
    76       !!---------------------------------------------------------------------- 
    77       !! * Arguments 
    78       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    79  
    80       !! * Local declarations 
     71      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129. 
     72      !!---------------------------------------------------------------------- 
     73      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
     74      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
     75      !! 
     76      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     77      !! 
    8178#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    82       INTEGER ::   ji                  ! dummy loop indices 
    83 #else 
    84       INTEGER ::   ji, jj              ! dummy loop indices 
    85 #endif 
    86       !!---------------------------------------------------------------------- 
    87  
    88       ! 0. Initialization 
    89       IF( kt == nit000 )   CALL tra_bbc_init 
    90  
    91       ! 1. Add the geothermal heat flux trend on temperature 
     79      INTEGER ::   ji       ! dummy loop indices 
     80#else 
     81      INTEGER ::   ji, jj   ! dummy loop indices 
     82#endif 
     83      !!---------------------------------------------------------------------- 
     84 
     85      IF( kt == nit000 )   CALL tra_bbc_init      ! Initialization 
     86 
     87      IF( l_trdtra )   THEN         ! Save ta and sa trends 
     88         ztrdt(:,:,:) = ta(:,:,:)  
     89         ztrds(:,:,:) = 0.e0 
     90      ENDIF 
     91 
     92      ! Add the geothermal heat flux trend on temperature 
    9293 
    9394      SELECT CASE ( ngeo_flux ) 
    94  
     95      ! 
    9596      CASE ( 1:2 )                !  geothermal heat flux 
    96  
    9797#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    9898         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    … …  
    106106         END DO 
    107107#endif 
    108  
    109       IF(ln_ctl) THEN 
    110          CALL prt_ctl(tab3d_1=ta, clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta') 
     108      END SELECT 
     109 
     110      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics 
     111         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
     112         CALL trd_mod( ztrdt, ztrds, jptra_trd_bbc, 'TRA', kt ) 
    111113      ENDIF 
    112  
    113       END SELECT 
    114  
     114      ! 
     115      IF(ln_ctl)   CALL prt_ctl(tab3d_1=ta, clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta') 
     116      ! 
    115117   END SUBROUTINE tra_bbc 
    116118 
    … …  
    132134      !! ** Action  : - compute the heat geothermal trend qgh_trd 
    133135      !!              - compute the bottom ocean level nbotlevt 
    134       !! 
    135       !! history : 
    136       !!  8.5  ! 02-11 (A. Bozec) original code 
    137       !!---------------------------------------------------------------------- 
    138       !! * Modules used 
     136      !!---------------------------------------------------------------------- 
    139137      USE iom 
    140  
    141       !! * local declarations 
     138      !! 
    142139      INTEGER  ::   ji, jj              ! dummy loop indices 
    143140      INTEGER  ::   inum                ! temporary logical unit 
    144  
    145       NAMELIST/nambbc/ngeo_flux, ngeo_flux_const  
    146       !!---------------------------------------------------------------------- 
    147  
    148       ! Read Namelist nambbc : bottom momentum boundary condition 
    149       REWIND ( numnam ) 
     141      !!---------------------------------------------------------------------- 
     142 
     143      REWIND ( numnam )              ! Read Namelist nambbc : bottom momentum boundary condition 
    150144      READ   ( numnam, nambbc ) 
    151145 
    152       ! Control print 
     146      !                              ! Control print 
    153147      IF(lwp) WRITE(numout,*) 
    154148      IF(lwp) WRITE(numout,*) 'tra_bbc : tempearture Bottom Boundary Condition (bbc)' 
    … …  
    160154      IF(lwp) WRITE(numout,*) 
    161155 
    162       ! level of the ocean bottom at T-point 
    163  
     156      !                              ! level of the ocean bottom at T-point 
    164157      DO jj = 1, jpj 
    165158         DO ji = 1, jpi 
    … …  
    168161      END DO 
    169162 
    170       ! initialization of geothermal heat flux 
    171  
    172       SELECT CASE ( ngeo_flux ) 
    173  
     163 
     164      SELECT CASE ( ngeo_flux )      ! initialization of geothermal heat flux 
     165      ! 
    174166      CASE ( 0 )                ! no geothermal heat flux 
    175167         IF(lwp) WRITE(numout,*) 
    176168         IF(lwp) WRITE(numout,*) '             *** no geothermal heat flux' 
    177  
     169         ! 
    178170      CASE ( 1 )                ! constant flux 
    179171         IF(lwp) WRITE(numout,*) '             *** constant heat flux  =   ', ngeo_flux_const 
    180172         qgh_trd(:,:) = ngeo_flux_const 
    181  
     173         ! 
    182174      CASE ( 2 )                ! variable geothermal heat flux 
    183175         ! read the geothermal fluxes in mW/m2 
    184  
     176         ! 
    185177         IF(lwp) WRITE(numout,*) '             *** variable geothermal heat flux' 
    186178         CALL iom_open ( 'geothermal_heating.nc', inum ) 
    187179         CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd ) 
    188180         CALL iom_close (inum) 
    189  
     181         ! 
    190182         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2 
    191  
     183         ! 
    192184      CASE DEFAULT 
    193185         WRITE(ctmp1,*) '     bad flag value for ngeo_flux = ', ngeo_flux 
    194186         CALL ctl_stop( ctmp1 ) 
     187         ! 
    195188      END SELECT 
    196189 
    … …  
    198191 
    199192      SELECT CASE ( ngeo_flux ) 
    200  
     193      ! 
    201194      CASE ( 1:2 )                !  geothermal heat flux 
    202  
    203195#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    204196         DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    … …  
    212204         END DO 
    213205#endif 
    214  
    215206      END SELECT 
    216  
     207      ! 
    217208   END SUBROUTINE tra_bbc_init 
    218209 

  • trunk/NEMO/OPA_SRC/TRA/trabbl.F90

    r481 r503  
    44   !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme 
    55   !!============================================================================== 
     6   !! History :  8.0  !  96-06  (L. Mortier)  Original code 
     7   !!            8.0  !  97-11  (G. Madec)  Optimization 
     8   !!            8.5  !  02-08  (G. Madec)  free form + modules 
     9   !!---------------------------------------------------------------------- 
    610#if   defined key_trabbl_dif   ||   defined key_trabbl_adv   || defined key_esopa 
    711   !!---------------------------------------------------------------------- 
    812   !!   'key_trabbl_dif'   or            diffusive bottom boundary layer 
    913   !!   'key_trabbl_adv'                 advective bottom boundary layer 
     14   !!---------------------------------------------------------------------- 
    1015   !!---------------------------------------------------------------------- 
    1116   !!   tra_bbl_dif  : update the active tracer trends due to the bottom 
    … …  
    1520   !!   tra_bbl_init : initialization, namlist read, parameters control 
    1621   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    18    USE oce                  ! ocean dynamics and active tracers 
    19    USE dom_oce              ! ocean space and time domain 
    20    USE trdmod_oce           ! ocean variables trends 
    21    USE in_out_manager       ! I/O manager 
    22    USE lbclnk               ! ocean lateral boundary conditions 
    23    USE prtctl               ! Print control 
     22   USE oce                ! ocean dynamics and active tracers 
     23   USE dom_oce            ! ocean space and time domain 
     24   USE trdmod             ! ocean active tracers trends 
     25   USE trdmod_oce         ! ocean variables trends 
     26   USE in_out_manager     ! I/O manager 
     27   USE lbclnk             ! ocean lateral boundary conditions 
     28   USE prtctl             ! Print control 
    2429 
    2530   IMPLICIT NONE 
    2631   PRIVATE 
    2732 
    28    !! * Routine accessibility 
    2933   PUBLIC tra_bbl_dif    ! routine called by step.F90 
    3034   PUBLIC tra_bbl_adv    ! routine called by step.F90 
    3135 
    32    !! * Shared module variables 
    33    REAL(wp), PUBLIC ::            &  !!: * bbl namelist * 
    34       atrbbl = 1.e+3                  !: lateral coeff. for bottom boundary  
    35       !                               !  layer scheme (m2/s)  
     36   !!* Namelist nambbl: bottom boundary layer 
     37   REAL(wp), PUBLIC ::   atrbbl = 1.e+3   !: lateral coeff. for bottom boundary layer scheme (m2/s) 
     38   NAMELIST/nambbl/ atrbbl 
     39 
    3640# if defined key_trabbl_dif 
    37    LOGICAL, PUBLIC, PARAMETER ::   &  !: 
    38       lk_trabbl_dif = .TRUE.          !: diffusive bottom boundary layer flag 
     41   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .TRUE.          !: diffusive bottom boundary layer flag 
    3942# else 
    40    LOGICAL, PUBLIC, PARAMETER ::   &  !: 
    41       lk_trabbl_dif = .FALSE.         !: diffusive bottom boundary layer flag 
     43   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .FALSE.         !: diffusive bottom boundary layer flag 
    4244# endif 
    4345 
    4446# if defined key_trabbl_adv 
    45    LOGICAL, PUBLIC, PARAMETER ::    &  !: 
    46       lk_trabbl_adv = .TRUE.   !: advective bottom boundary layer flag 
    47    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    48        u_bbl, v_bbl,  &  !: velocity involved in exhanges in the advective BBL 
    49        w_bbl             !: vertical increment of velocity due to advective BBL 
    50        !                 !  only affect tracer vertical advection 
     47   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .TRUE.   !: advective bottom boundary layer flag 
     48   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   u_bbl      !: 3 components of the velocity 
     49   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   v_bbl      !: associated with advective BBL 
     50   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   w_bbl      !: (only affect tracer) 
    5151# else 
    52    LOGICAL, PUBLIC, PARAMETER ::    &  !: 
    53       lk_trabbl_adv = .FALSE.  !: advective bottom boundary layer flag 
     52   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE.  !: advective bottom boundary layer flag 
    5453# endif 
    5554 
    56    !! * Module variables 
    57    INTEGER, DIMENSION(jpi,jpj) ::   &  !: 
    58       mbkt,           &   ! vertical index of the bottom ocean T-level 
    59       mbku, mbkv          ! vertical index of the bottom ocean U/V-level 
     55   INTEGER, DIMENSION(jpi,jpj) ::   mbkt          ! vertical index of the bottom ocean T-level 
     56   INTEGER, DIMENSION(jpi,jpj) ::   mbku, mbkv    ! vertical index of the bottom ocean U/V-level 
    6057 
    6158   !! * Substitutions 
    … …  
    6360#  include "vectopt_loop_substitute.h90" 
    6461   !!---------------------------------------------------------------------- 
    65    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     62   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    6663   !! $Header$  
    67    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     64   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6865   !!---------------------------------------------------------------------- 
    6966 
    … …  
    10299      !! ** Action  : - update (ta,sa) at the bottom level with the bottom 
    103100      !!                boundary layer trend 
    104       !!              - save the trends in tldfbbl/sldfbbl ('key_trdtra') 
    105       !! 
    106       !! References : 
    107       !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    108       !! 
    109       !! History : 
    110       !!   8.0  !  96-06  (L. Mortier)  Original code 
    111       !!   8.0  !  97-11  (G. Madec)  Optimization 
    112       !!   8.5  !  02-08  (G. Madec)  free form + modules 
    113       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    114       !!---------------------------------------------------------------------- 
    115       !! * Modules used      
    116       USE oce, ONLY :    ztdta => ua,     & ! use ua as 3D workspace    
    117                          ztdsa => va        ! use va as 3D workspace    
    118       USE eosbn2                            ! equation of state 
    119  
    120       !! * Arguments  
    121       INTEGER, INTENT( in ) ::   kt         ! ocean time-step 
    122  
    123       !! * Local declarations 
    124       INTEGER ::   ji, jj                   ! dummy loop indices 
    125       INTEGER ::   ik 
    126       INTEGER ::   ii0, ii1, ij0, ij1       ! temporary integers 
     101      !!              - save the trends in ztrdt/ztrds ('key_trdtra') 
     102      !! 
     103      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
     104      !!---------------------------------------------------------------------- 
     105      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
     106      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
     107      USE eosbn2                      ! equation of state 
     108      !! 
     109      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
     110      !! 
     111      INTEGER  ::   ji, jj                   ! dummy loop indices 
     112      INTEGER  ::   ik 
     113      INTEGER  ::   ii0, ii1, ij0, ij1       ! temporary integers 
    127114      INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers 
    128115      REAL(wp) ::   ze3u, ze3v              ! temporary scalars 
    129       INTEGER ::   iku, ikv 
     116      INTEGER  ::   iku, ikv 
    130117      REAL(wp) ::   & 
    131118         zsign, zt, zs, zh, zalbet,      &  ! temporary scalars 
    132119         zgdrho, zbtr, zta, zsa 
    133120      REAL(wp), DIMENSION(jpi,jpj) ::    & 
    134         zki, zkj, zkw, zkx, zky, zkz,    &  ! temporary workspace arrays 
     121        zki, zkj, zkw, zkx, zky, zkz,    &  ! 2D workspace arrays 
    135122        ztnb, zsnb, zdep,                & 
    136123        ztbb, zsbb, zahu, zahv 
    137       REAL(wp) ::   & 
    138          fsalbt, pft, pfs, pfh              ! statement function 
     124      REAL(wp) ::    fsalbt, pft, pfs, pfh   ! statement function 
    139125      !!---------------------------------------------------------------------- 
    140126      ! ratio alpha/beta 
    … …  
    161147      IF( kt == nit000 )   CALL tra_bbl_init 
    162148 
    163       ! Save ta and sa trends 
    164       IF( l_trdtra )   THEN 
    165          ztdta(:,:,:) = ta(:,:,:)  
    166          ztdsa(:,:,:) = sa(:,:,:)  
     149      IF( l_trdtra )   THEN         ! Save ta and sa trends 
     150         ztrdt(:,:,:) = ta(:,:,:)  
     151         ztrds(:,:,:) = sa(:,:,:)  
    167152      ENDIF 
    168153 
    … …  
    170155      ! ----------------------------------------------------------------- 
    171156      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 
    172  
    173157#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    174158      jj = 1 
    … …  
    387371 
    388372      IF( cp_cfg == "orca" ) THEN 
    389  
     373         ! 
    390374         SELECT CASE ( jp_cfg ) 
    391375         !                                           ! ======================= 
    … …  
    397381            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    398382            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    399  
     383            ! 
    400384            ! Red Sea enhancement of BBL 
    401385            ij0 =  88   ;   ij1 =  88 
    … …  
    403387            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    404388            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    405  
     389            ! 
    406390            !                                        ! ======================= 
    407391         CASE ( 4 )                                  !  ORCA_R4 configuration 
    … …  
    412396            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    413397            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    414  
     398            ! 
    415399         END SELECT 
    416  
     400      ! 
    417401      ENDIF 
    418402 
    … …  
    439423      END DO 
    440424 
    441       ! save the trends for diagnostic 
    442       ! BBL lateral diffusion tracers trends 
    443       IF( l_trdtra )   THEN 
    444 #  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    445          jj = 1 
    446          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    447 #  else 
    448          DO jj = 2, jpjm1 
    449             DO ji = 2, jpim1 
    450 #  endif 
    451             ik = max( mbathy(ji,jj)-1, 1 ) 
    452             tldfbbl(ji,jj) = ta(ji,jj,ik) - ztdta(ji,jj,ik) 
    453             sldfbbl(ji,jj) = sa(ji,jj,ik) - ztdsa(ji,jj,ik) 
    454 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    455             END DO 
    456 #  endif 
    457          END DO 
    458  
     425      IF( l_trdtra ) THEN      ! save the BBL lateral diffusion trends for diagnostic 
     426         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
     427         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
     428         CALL trd_mod(ztrdt, ztrds, jptra_trd_bbl, 'TRA', kt) 
    459429      ENDIF 
    460430 
    461       IF(ln_ctl) THEN 
    462          CALL prt_ctl(tab3d_1=ta, clinfo1=' bbl  - Ta: ', mask1=tmask, & 
    463             &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    464       ENDIF 
    465  
     431      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' bbl  - Ta: ', mask1=tmask,   & 
     432         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     433      ! 
    466434   END SUBROUTINE tra_bbl_dif 
    467435 
    … …  
    489457      !! ** Method  :   Read the nambbl namelist and check the parameters 
    490458      !!      called by tra_bbl at the first timestep (nit000) 
    491       !! 
    492       !! History : 
    493       !!    8.5  !  02-08  (G. Madec)  Original code 
    494       !!---------------------------------------------------------------------- 
    495       !! * Local declarations 
     459      !!---------------------------------------------------------------------- 
    496460      INTEGER ::   ji, jj      ! dummy loop indices 
    497461      REAL(wp),  DIMENSION(jpi,jpj) :: zmbk   
    498  
    499       NAMELIST/nambbl/ atrbbl 
    500       !!---------------------------------------------------------------------- 
    501  
    502       ! Read Namelist nambbl : bottom boundary layer scheme 
    503       ! -------------------- 
    504       REWIND ( numnam ) 
     462      !!---------------------------------------------------------------------- 
     463 
     464      REWIND ( numnam )              ! Read Namelist nambbl : bottom boundary layer scheme 
    505465      READ   ( numnam, nambbl ) 
    506466 
    507  
    508       ! Parameter control and print 
    509       ! --------------------------- 
    510       IF(lwp) THEN 
     467      IF(lwp) THEN                   ! Parameter control and print 
    511468         WRITE(numout,*) 
    512469         WRITE(numout,*) 'tra_bbl_init : ' 
    513470         WRITE(numout,*) '~~~~~~~~~~~~' 
    514          IF (lk_trabbl_dif ) THEN 
    515             WRITE(numout,*) '               * Diffusive Bottom Boundary Layer' 
    516          ENDIF  
    517          IF( lk_trabbl_adv ) THEN 
    518             WRITE(numout,*) '               * Advective Bottom Boundary Layer' 
    519          ENDIF 
    520          WRITE(numout,*) '          Namelist nambbl : set bbl parameters' 
    521          WRITE(numout,*) 
     471         IF (lk_trabbl_dif )   WRITE(numout,*) '               * Diffusive Bottom Boundary Layer' 
     472         IF( lk_trabbl_adv )   WRITE(numout,*) '               * Advective Bottom Boundary Layer' 
     473         WRITE(numout,*) '       Namelist nambbl : set bbl parameters' 
    522474         WRITE(numout,*) '          bottom boundary layer coef.    atrbbl = ', atrbbl 
    523          WRITE(numout,*) 
    524475      ENDIF 
    525476  
    … …  
    545496 
    546497# if defined key_trabbl_adv 
    547       ! initialisation of w_bbl to zero 
    548       w_bbl(:,:,:) = 0.e0     
     498      w_bbl(:,:,:) = 0.e0          ! initialisation of w_bbl to zero 
    549499# endif 
    550  
     500      ! 
    551501   END SUBROUTINE tra_bbl_init 
    552502 
    … …  
    558508   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE.   !: adv  bbl flag 
    559509CONTAINS 
    560    SUBROUTINE tra_bbl_dif (kt )              ! Empty routine 
    561       INTEGER, INTENT(in) :: kt 
     510   SUBROUTINE tra_bbl_dif( kt )              ! Empty routine 
    562511      WRITE(*,*) 'tra_bbl_dif: You should not have seen this print! error?', kt 
    563512   END SUBROUTINE tra_bbl_dif 
    564    SUBROUTINE tra_bbl_adv (kt )              ! Empty routine 
    565       INTEGER, INTENT(in) :: kt 
     513   SUBROUTINE tra_bbl_adv( kt )              ! Empty routine 
    566514      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt 
    567515   END SUBROUTINE tra_bbl_adv 

  • trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90

    r481 r503  
    22   !!                     ***  trabbl_adv.h90  *** 
    33   !!---------------------------------------------------------------------- 
     4   !! History :  8.5  !  02-12  (A. de Miranda, G. Madec)  Original Code  
     5   !!            9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ) 
     6   !!----------------------------------------------------------------------      
    47 
    58   !!---------------------------------------------------------------------- 
    69   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    710   !! $Header$  
    8    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    912   !!---------------------------------------------------------------------- 
    1013 
    … …  
    4346      !! ** Action  : - update (ta,sa) at the bottom level with the bottom 
    4447      !!                boundary layer trend 
    45       !!              - save the lateral diffusion trends in tldfbbl/sldfbbl ('key_trdtra') 
    46       !!              - save the horizontal advection trends in tladbbl/sladbbl ('key_trdtra') 
    4748      !! 
    48       !! References : 
    49       !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
     49      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
     50      !!----------------------------------------------------------------------      
     51      USE eosbn2                      ! equation of state 
     52      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
     53      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
    5054      !! 
    51       !! History : 
    52       !!   8.5  !  02-12  (A. de Miranda, G. Madec)  Original Code  
    53       !!   9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ) 
    54       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    55       !!----------------------------------------------------------------------      
    56       !! * Modules used 
    57       USE eosbn2                           ! equation of state 
    58       USE oce, ONLY :    ztdta => ua,    & ! use ua as 3D workspace    
    59                          ztdsa => va       ! use va as 3D workspace    
    60  
    61       !! * Arguments 
    62       INTEGER, INTENT( in ) ::   kt        ! ocean time-step  
    63        
    64       !! * Local declarations 
    65       INTEGER :: ji, jj, jk                ! dummy loop indices 
    66       INTEGER :: ik, iku, ikv              ! temporary integers 
    67  
    68       REAL(wp) ::   & 
    69          zsign, zt, zs, zh, zalbet,     &  ! temporary scalars 
    70          zgdrho, zbtr, zta, zsa            !    "         "  
    71       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    72          ztnb, zsnb, zdep, ztbb, zsbb 
    73       REAL(wp), DIMENSION(jpi,jpj) ::   &  ! temporary workspace arrays 
    74          zalphax, zwu, zunb,            &  !    "                  " 
    75          zalphay, zwv, zvnb,            &  !    "                  " 
    76          zwx, zwy, zww, zwz                !    "                  " 
    77       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    78          zhdivn                            ! temporary workspace arrays 
    79       REAL(wp) ::   & 
    80          zfui, zfvj, zbt, zsigna,       &  ! temporary scalars 
    81          iku1, iku2, ikv1, ikv2,        &  ! temporary scalars 
    82          ze3u,ze3v 
    83       REAL(wp) ::   & 
    84          fsalbt, pft, pfs, pfh             ! statement function 
     55      INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
     56      !! 
     57      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
     58      INTEGER  ::   ik                ! temporary integers 
     59      INTEGER  ::   iku, iku1, iku2   !    "          " 
     60      INTEGER  ::   ikv, ikv1, ikv2   !    "          " 
     61      REAL(wp) ::   zsign, zh, zalbet     ! temporary scalars 
     62      REAL(wp) ::   zgdrho, zbtr          !    "         "  
     63      REAL(wp) ::   zbt, zsigna           !    "         " 
     64      REAL(wp) ::   zfui, ze3u, zt, zta   !    "         " 
     65      REAL(wp) ::   zfvj, ze3v, zs, zsa   !    "         " 
     66      REAL(wp), DIMENSION(jpi,jpj)     ::   zalphax, zwu, zunb   ! temporary 2D workspace 
     67      REAL(wp), DIMENSION(jpi,jpj)     ::   zalphay, zwv, zvnb   !    "             " 
     68      REAL(wp), DIMENSION(jpi,jpj)     ::   zwx, zwy, zww, zwz   !    "             " 
     69      REAL(wp), DIMENSION(jpi,jpj)     ::   ztbb, zsbb           !    "             " 
     70      REAL(wp), DIMENSION(jpi,jpj)     ::   ztnb, zsnb, zdep     !    "             " 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhdivn               ! temporary 3D workspace 
     72      REAL(wp) ::   fsalbt, pft, pfs, pfh   ! statement function 
    8573      !!---------------------------------------------------------------------- 
    8674      ! ratio alpha/beta 
    … …  
    10896      IF( kt == nit000 )   CALL tra_bbl_init    ! initialization at first time-step 
    10997 
    110       ! Save ta and sa trends 
    111       IF( l_trdtra )   THEN 
    112          ztdta(:,:,:) = ta(:,:,:)  
    113          ztdsa(:,:,:) = sa(:,:,:)  
     98      IF( l_trdtra )   THEN      ! Save ta and sa trends 
     99         ztrdt(:,:,:) = ta(:,:,:)  
     100         ztrds(:,:,:) = sa(:,:,:)  
    114101      ENDIF 
    115102 
    … …  
    146133 
    147134      SELECT CASE ( neos ) 
    148  
     135      ! 
    149136      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    150  
     137      ! 
    151138      DO jj = 1, jpjm1 
    152         DO ji = 1, fs_jpim1   ! vector opt. 
    153       !   ... temperature, salinity anomalie and depth 
    154           zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
    155           zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
    156           zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    157       !   ... masked ratio alpha/beta 
    158           zalbet = fsalbt( zt, zs, zh ) * umask(ji,jj,1) 
    159       !   ... local density gradient along i-bathymetric slope 
    160           zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   & 
    161              &       -      ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 
    162           zgdrho = zgdrho * umask(ji,jj,1) 
    163       !   ... sign of local i-gradient of density multiplied by the i-slope 
    164           zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    165           zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    166           zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 
    167         END DO 
    168       END DO 
    169  
     139         DO ji = 1, fs_jpim1   ! vector opt. 
     140            !   ... temperature, salinity anomalie and depth 
     141            zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
     142            zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
     143            zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
     144            !   ... masked ratio alpha/beta 
     145            zalbet = fsalbt( zt, zs, zh ) * umask(ji,jj,1) 
     146            !   ... local density gradient along i-bathymetric slope 
     147            zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   & 
     148               &       -      ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 
     149            zgdrho = zgdrho * umask(ji,jj,1) 
     150            !   ... sign of local i-gradient of density multiplied by the i-slope 
     151            zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     152            zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     153            zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 
     154         END DO 
     155      END DO 
     156      ! 
    170157      DO jj = 1, jpjm1 
    171         DO ji = 1, fs_jpim1   ! vector opt. 
    172       !   ... temperature, salinity anomalie and depth 
    173           zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
    174           zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
    175           zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    176       !   ... masked ratio alpha/beta 
    177           zalbet = fsalbt( zt, zs, zh ) * vmask(ji,jj,1) 
    178       !   ... local density gradient along j-bathymetric slope 
    179           zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
    180              &       -      ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
    181           zgdrho = zgdrho*vmask(ji,jj,1) 
    182       !   ... sign of local j-gradient of density multiplied by the j-slope 
    183           zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    184           zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    185           zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
    186         END DO 
    187       END DO 
    188  
    189  
     158         DO ji = 1, fs_jpim1   ! vector opt. 
     159            !   ... temperature, salinity anomalie and depth 
     160            zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
     161            zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
     162            zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
     163            !   ... masked ratio alpha/beta 
     164            zalbet = fsalbt( zt, zs, zh ) * vmask(ji,jj,1) 
     165            !   ... local density gradient along j-bathymetric slope 
     166            zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
     167               &       -      ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
     168            zgdrho = zgdrho*vmask(ji,jj,1) 
     169            !   ... sign of local j-gradient of density multiplied by the j-slope 
     170            zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     171            zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     172            zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
     173         END DO 
     174      END DO 
     175      ! 
    190176      CASE ( 1 )               ! Linear formulation function of temperature only 
    191                                ! 
     177      ! 
    192178      DO jj = 1, jpjm1 
    193179         DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    207193         END DO 
    208194      END DO 
    209  
     195      ! 
    210196      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
     197      ! 
    211198      DO jj = 1, jpjm1 
    212199         DO ji = 1, fs_jpim1   ! vector opt.             
    … …  
    228215         END DO 
    229216      END DO 
    230  
     217      ! 
    231218      CASE DEFAULT 
    232  
    233219         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    234220         CALL ctl_stop( ctmp1 ) 
    235  
     221         ! 
    236222      END SELECT 
    237223 
    … …  
    359345      ! BBL lateral advection tracers trends 
    360346      IF( l_trdtra )   THEN 
    361 #  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    362          jj = 1 
    363          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    364 #  else 
    365          DO jj = 2, jpjm1 
    366             DO ji = 2, jpim1 
    367 #  endif 
    368             ik = mbkt(ji,jj) 
    369             tladbbl(ji,jj) = ta(ji,jj,ik) - ztdta(ji,jj,ik) 
    370             sladbbl(ji,jj) = sa(ji,jj,ik) - ztdsa(ji,jj,ik) 
    371 #  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    372             END DO 
    373 #  endif 
    374          END DO 
    375  
     347         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
     348         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
     349         CALL trd_mod(ztrdt, ztrds, jptra_trd_bbl, 'TRA', kt) 
    376350      ENDIF 
    377351 
    378       IF(ln_ctl) THEN 
    379          CALL prt_ctl(tab3d_1=ta, clinfo1=' bbl  - Ta: ', mask1=tmask, & 
    380             &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    381       ENDIF 
    382  
     352      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' bbl  - Ta: ', mask1=tmask,   & 
     353         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    383354 
    384355      ! 6. Vertical advection velocities 
    … …  
    475446      ! 7. compute additional vertical velocity to be used in t boxes 
    476447      ! ------------------------------------------------------------- 
    477  
    478448      ! ... Computation from the bottom 
    479449      ! Note that w_bbl(:,:,jpk) has been set to 0 in tra_bbl_init 
    … …  
    488458      ! Boundary condition on w_bbl   (unchanged sign) 
    489459      CALL lbc_lnk( w_bbl, 'W', 1. ) 
    490  
     460      ! 
    491461   END SUBROUTINE tra_bbl_adv 

  • trunk/NEMO/OPA_SRC/TRA/tradmp.F90

    r473 r503  
    44   !! Ocean physics: internal restoring trend on active tracers (T and S) 
    55   !!====================================================================== 
     6   !! History :  5.0  !  91-03  (O. Marti, G. Madec)  Original code 
     7   !!                 !  92-06  (M. Imbard)  doctor norme 
     8   !!                 !  96-01  (G. Madec)  statement function for e3 
     9   !!                 !  97-05  (G. Madec)  macro-tasked on jk-slab 
     10   !!                 !  98-07  (M. Imbard, G. Madec) ORCA version 
     11   !!            7.0  !  01-02  (M. Imbard)  cofdis, Original code 
     12   !!            8.1  !  01-02  (G. Madec, E. Durand)  cleaning 
     13   !!            8.5  !  02-08  (G. Madec, E. Durand)  free form + modules 
     14   !!---------------------------------------------------------------------- 
    615#if   defined key_tradmp   ||   defined key_esopa 
    716   !!---------------------------------------------------------------------- 
    817   !!   key_tradmp                                         internal damping 
     18   !!---------------------------------------------------------------------- 
    919   !!---------------------------------------------------------------------- 
    1020   !!   tra_dmp      : update the tracer trend with the internal damping 
    … …  
    1424   !!   cofdis       : compute the distance to the coastline 
    1525   !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    1726   USE oce             ! ocean dynamics and tracers variables 
    1827   USE dom_oce         ! ocean space and time domain variables 
    … …  
    3140   PRIVATE 
    3241 
    33    !! * Routine accessibility 
    34    PUBLIC tra_dmp   ! routine called by step.F90 
    35  
    36    !! * Shared module variables 
    37    LOGICAL , PUBLIC & 
     42   PUBLIC tra_dmp      ! routine called by step.F90 
     43 
    3844#if ! defined key_agrif 
    39    , PARAMETER  & 
     45   LOGICAL, PUBLIC, PARAMETER ::   lk_tradmp = .TRUE.     !: internal damping flag 
     46#else 
     47   LOGICAL, PUBLIC            ::   lk_tradmp = .TRUE.     !: internal damping flag 
    4048#endif 
    41    ::   lk_tradmp = .TRUE.    !: internal damping flag 
    42  
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
    44       strdmp,              &  ! damping salinity trend (psu/s) 
    45       resto                   ! restoring coeff. on T and S (s-1) 
    46  
    47    !! * Module variables 
    48    INTEGER  ::             & !!! * newtonian damping namelist (mandmp) * 
    49       ndmp   =   -1 ,      &  ! = 0/-1/'latitude' for damping over T and S 
    50       ndmpf  =    2 ,      &  ! = 1 create a damping.coeff NetCDF file  
    51       nmldmp =    0           ! = 0/1/2 flag for damping in the mixed layer 
    52    REAL(wp) ::             & !!!  * newtonian damping namelist * 
    53       sdmp   =   50.,      &  ! surface time scale for internal damping (days) 
    54       bdmp   =  360.,      &  ! bottom time scale for internal damping (days) 
    55       hdmp   =  800.          ! depth of transition between sdmp and bdmp (meters) 
     49   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   strdmp   !: damping salinity trend (psu/s) 
     50   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   resto    !: restoring coeff. on T and S (s-1) 
     51    
     52   !!* newtonian damping namelist (mandmp)  
     53   INTEGER  ::   ndmp   =   -1    ! = 0/-1/'latitude' for damping over T and S 
     54   INTEGER  ::   ndmpf  =    2    ! = 1 create a damping.coeff NetCDF file  
     55   INTEGER  ::   nmldmp =    0    ! = 0/1/2 flag for damping in the mixed layer 
     56   REAL(wp) ::   sdmp   =   50.   ! surface time scale for internal damping (days) 
     57   REAL(wp) ::   bdmp   =  360.   ! bottom time scale for internal damping (days) 
     58   REAL(wp) ::   hdmp   =  800.   ! depth of transition between sdmp and bdmp (meters) 
     59   NAMELIST/namtdp/ ndmp, ndmpf, nmldmp, sdmp, bdmp, hdmp 
    5660 
    5761   !! * Substitutions 
    … …  
    5963#  include "vectopt_loop_substitute.h90" 
    6064   !!---------------------------------------------------------------------- 
    61    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     65   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    6266   !! $Header$  
    63    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     67   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6468   !!---------------------------------------------------------------------- 
    6569 
    … …  
    8589      !!                damping trends. 
    8690      !!              - save the trends in (ttrd,strd) ('key_trdtra') 
    87       !! 
    88       !! History : 
    89       !!   7.0  !         (G. Madec)  Original code 
    90       !!        !  96-01  (G. Madec)  
    91       !!        !  97-05  (G. Madec)  macro-tasked on jk-slab 
    92       !!   8.5  !  02-08  (G. Madec)  free form + modules 
    93       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    94       !!---------------------------------------------------------------------- 
    95       !! * Modules used      
    96       USE oce, ONLY :    ztdta => ua,   & ! use ua as 3D workspace    
    97                          ztdsa => va      ! use va as 3D workspace    
    98  
    99       !! * Arguments 
    100       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    101  
    102       !! * Local declarations 
     91      !!---------------------------------------------------------------------- 
     92      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
     93      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
     94      !! 
     95      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     96      !! 
    10397      INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    10498      REAL(wp) ::   ztest, zta, zsa       ! temporary scalars 
    10599      !!---------------------------------------------------------------------- 
    106100 
    107       ! 0. Initialization (first time-step only) 
    108       !    -------------- 
    109       IF( kt == nit000 ) CALL tra_dmp_init 
    110  
    111       ! Save ta and sa trends 
    112       IF( l_trdtra )   THEN 
    113          ztdta(:,:,:) = ta(:,:,:)  
    114          ztdsa(:,:,:) = sa(:,:,:)  
     101      IF( kt == nit000 )   CALL tra_dmp_init      ! Initialization 
     102 
     103      IF( l_trdtra )   THEN                       ! Save ta and sa trends 
     104         ztrdt(:,:,:) = ta(:,:,:)  
     105         ztrds(:,:,:) = sa(:,:,:)  
    115106      ENDIF 
    116107 
    … …  
    120111 
    121112      SELECT CASE ( nmldmp ) 
    122  
     113      ! 
    123114      CASE( 0 )                ! newtonian damping throughout the water column 
    124115         DO jk = 1, jpkm1 
    … …  
    135126            END DO 
    136127         END DO 
    137  
     128         ! 
    138129      CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s) 
    139130         DO jk = 1, jpkm1 
    … …  
    156147            END DO 
    157148         END DO 
    158  
     149         ! 
    159150      CASE ( 2 )                ! no damping in the mixed layer  
    160151         DO jk = 1, jpkm1 
    … …  
    176167            END DO 
    177168         END DO 
    178  
     169         ! 
    179170      END SELECT 
    180171 
    181       ! save the trends for diagnostic 
    182       ! damping salinity trends 
    183       IF( l_trdtra )   THEN 
    184          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) 
    185          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) 
    186          CALL trd_mod(ztdta, ztdsa, jpttddoe, 'TRA', kt) 
     172      IF( l_trdtra )   THEN          ! save the damping tracer trends for diagnostic 
     173         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
     174         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
     175         CALL trd_mod(ztrdt, ztrds, jptra_trd_dmp, 'TRA', kt) 
    187176      ENDIF 
    188  
    189       IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    190          CALL prt_ctl(tab3d_1=ta, clinfo1=' dmp  - Ta: ', mask1=tmask, & 
    191             &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    192       ENDIF 
    193  
    194  
     177      !                              ! Control print 
     178      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
     179         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     180      ! 
    195181   END SUBROUTINE tra_dmp 
    196182 
    … …  
    204190      !! ** Method  :   read the nammbf namelist and check the parameters 
    205191      !!      called by tra_dmp at the first timestep (nit000) 
    206       !! 
    207       !! History : 
    208       !!   8.5  !  02-08  (G. Madec)  Original code 
    209       !!---------------------------------------------------------------------- 
    210       !! * Local declarations 
    211       NAMELIST/namtdp/ ndmp, ndmpf, nmldmp, sdmp, bdmp, hdmp 
    212       !!---------------------------------------------------------------------- 
    213  
    214       ! Read Namelist namtdp : temperature and salinity damping term 
    215       ! -------------------- 
    216       REWIND ( numnam ) 
     192      !!---------------------------------------------------------------------- 
     193 
     194      REWIND ( numnam )                  ! Read Namelist namtdp : temperature and salinity damping term 
    217195      READ   ( numnam, namtdp ) 
    218196      IF( lzoom )   nmldmp = 0           ! restoring to climatology at closed north or south boundaries 
    219197 
    220       ! Parameter control and print 
    221       ! --------------------------- 
    222       IF(lwp) THEN 
     198      IF(lwp) THEN                       ! Namelist print 
    223199         WRITE(numout,*) 
    224200         WRITE(numout,*) 'tra_dmp : T and S newtonian damping' 
    225201         WRITE(numout,*) '~~~~~~~' 
    226          WRITE(numout,*) '          Namelist namtdp : set damping parameter' 
    227          WRITE(numout,*) 
    228          WRITE(numout,*) '             T and S damping option         ndmp   = ', ndmp 
    229          WRITE(numout,*) '             create a damping.coeff file    ndmpf  = ', ndmpf 
    230          WRITE(numout,*) '             mixed layer damping option     nmldmp = ', nmldmp, '(zoom: forced to 0)' 
    231          WRITE(numout,*) '             surface time scale (days)      sdmp   = ', sdmp 
    232          WRITE(numout,*) '             bottom time scale (days)       bdmp   = ', bdmp 
    233          WRITE(numout,*) '             depth of transition (meters)   hdmp   = ', hdmp 
    234          WRITE(numout,*) 
     202         WRITE(numout,*) '       Namelist namtdp : set damping parameter' 
     203         WRITE(numout,*) '          T and S damping option         ndmp   = ', ndmp 
     204         WRITE(numout,*) '          create a damping.coeff file    ndmpf  = ', ndmpf 
     205         WRITE(numout,*) '          mixed layer damping option     nmldmp = ', nmldmp, '(zoom: forced to 0)' 
     206         WRITE(numout,*) '          surface time scale (days)      sdmp   = ', sdmp 
     207         WRITE(numout,*) '          bottom time scale (days)       bdmp   = ', bdmp 
     208         WRITE(numout,*) '          depth of transition (meters)   hdmp   = ', hdmp 
    235209      ENDIF 
    236210 
    237211      SELECT CASE ( ndmp ) 
    238  
    239       CASE ( -1 )               ! ORCA: damping in Red & Med Seas only 
    240          IF(lwp) WRITE(numout,*) '          tracer damping in the Med & Red seas only' 
    241  
    242       CASE ( 1:90 )             ! Damping poleward of 'ndmp' degrees 
    243          IF(lwp) WRITE(numout,*) '          tracer damping poleward of', ndmp, ' degrees' 
    244  
     212      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '          tracer damping in the Med & Red seas only' 
     213      CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '          tracer damping poleward of', ndmp, ' degrees' 
    245214      CASE DEFAULT 
    246215         WRITE(ctmp1,*) '          bad flag value for ndmp = ', ndmp 
    247216         CALL ctl_stop(ctmp1) 
    248  
    249217      END SELECT 
    250218 
    251  
    252219      SELECT CASE ( nmldmp ) 
    253  
    254       CASE ( 0 )                ! newtonian damping throughout the water column 
    255          IF(lwp) WRITE(numout,*) '          tracer damping throughout the water column' 
    256  
    257       CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s) 
    258          IF(lwp) WRITE(numout,*) '          no tracer damping in the turbocline' 
    259  
    260       CASE ( 2 )                ! no damping in the mixed layer  
    261          IF(lwp) WRITE(numout,*) '          no tracer damping in the mixed layer' 
    262  
     220      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '          tracer damping throughout the water column' 
     221      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '          no tracer damping in the turbocline (avt > 5 cm2/s)' 
     222      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '          no tracer damping in the mixed layer' 
    263223      CASE DEFAULT 
    264224         WRITE(ctmp1,*) '          bad flag value for nmldmp = ', nmldmp 
    265225         CALL ctl_stop(ctmp1) 
    266  
    267226      END SELECT 
    268227 
    269       IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem ) & 
    270            &   CALL ctl_stop( '          no temperature and/or salinity data ', & 
    271            &                  '          define key_dtatem and key_dtasal' ) 
     228      IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem )   & 
     229         &   CALL ctl_stop( 'no temperature and/or salinity data define key_dtatem and key_dtasal' ) 
    272230 
    273231      strdmp(:,:,:) = 0.e0       ! internal damping salinity trend (used in ocesbc) 
    274232 
    275       ! Damping coefficients initialization 
    276       ! ----------------------------------- 
    277  
    278       IF( lzoom ) THEN 
    279          CALL dtacof_zoom 
    280       ELSE 
    281          CALL dtacof 
     233      !                          ! Damping coefficients initialization 
     234      IF( lzoom ) THEN   ;   CALL dtacof_zoom 
     235      ELSE               ;   CALL dtacof 
    282236      ENDIF 
    283  
     237      ! 
    284238   END SUBROUTINE tra_dmp_init 
    285239 
    … …  
    297251      !! 
    298252      !! ** Action  : - resto, the damping coeff. for T and S 
    299       !! 
    300       !! History : 
    301       !!   9.0  !  03-09  (G. Madec)  Original code 
    302       !!---------------------------------------------------------------------- 
    303       !! * Local declarations 
    304       INTEGER ::   ji, jj, jk, jn      ! dummy loop indices 
    305       REAL(wp) ::   & 
    306          zlat, zlat0, zlat1, zlat2     ! temporary scalar 
    307       REAL(wp), DIMENSION(6)  ::   & 
    308          zfact                         ! temporary workspace 
     253      !!---------------------------------------------------------------------- 
     254      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
     255      REAL(wp) ::   zlat, zlat0, zlat1, zlat2   ! temporary scalar 
     256      REAL(wp), DIMENSION(6)  ::   zfact        ! temporary workspace 
    309257      !!---------------------------------------------------------------------- 
    310258 
    … …  
    321269      ! damping along the forced closed boundary over 6 grid-points 
    322270      DO jn = 1, 6 
    323          IF( lzoom_w )   resto( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : ) = zfact(jn) ! west  closed 
    324          IF( lzoom_s )   resto( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : ) = zfact(jn) ! south closed  
    325          IF( lzoom_e )   resto( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : ) & 
    326                        &              = zfact(jn)                                 ! east  closed  
    327          IF( lzoom_n )   resto( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : ) & 
    328                        &              = zfact(jn)                                 ! north closed 
     271         IF( lzoom_w )   resto( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : )                    = zfact(jn)   ! west  closed 
     272         IF( lzoom_s )   resto( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : )                    = zfact(jn)   ! south closed  
     273         IF( lzoom_e )   resto( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : ) = zfact(jn)   ! east  closed  
     274         IF( lzoom_n )   resto( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : ) = zfact(jn)   ! north closed 
    329275      END DO 
    330276 
    331277 
    332278      IF( lzoom_arct .AND. lzoom_anta ) THEN 
    333  
     279         ! 
    334280         ! ==================================================== 
    335281         !  ORCA configuration : arctic zoom or antarctic zoom 
    … …  
    364310            END DO 
    365311         END DO 
    366  
     312         ! 
    367313      ENDIF 
    368314 
    369315      ! ... Mask resto array 
    370316      resto(:,:,:) = resto(:,:,:) * tmask(:,:,:) 
    371  
     317      ! 
    372318   END SUBROUTINE dtacof_zoom 
     319 
    373320 
    374321   SUBROUTINE dtacof 
    … …  
    383330      !! 
    384331      !! ** Action  : - resto, the damping coeff. for T and S 
    385       !! 
    386       !! History : 
    387       !!   5.0  !  91-03  (O. Marti, G. Madec)  Original code 
    388       !!        !  92-06  (M. Imbard)  doctor norme 
    389       !!        !  96-01  (G. Madec) statement function for e3 
    390       !!        !  98-07  (M. Imbard, G. Madec) ORCA version 
    391       !!        !  00-08  (G. Madec, D. Ludicone)  
    392       !!---------------------------------------------------------------------- 
    393       !! * Modules used 
     332      !!---------------------------------------------------------------------- 
    394333      USE iom 
    395334      USE ioipsl 
    396  
    397       !! * Local declarations 
     335      !! 
    398336      INTEGER ::   ji, jj, jk     ! dummy loop indices 
    399337      INTEGER ::   itime 
    400338      INTEGER ::   ii0, ii1, ij0, ij1  !    "          " 
    401       INTEGER ::   & 
    402          idmp,     &  ! logical unit for file restoring damping term 
    403          icot         ! logical unit for file distance to the coast 
     339      INTEGER ::   idmp         ! logical unit for file restoring damping term 
     340      INTEGER ::   icot         ! logical unit for file distance to the coast 
    404341      CHARACTER (len=32) :: clname3 
    405       REAL(wp) ::   & 
    406          zdate0, zinfl, zlon,         & ! temporary scalars 
    407          zlat, zlat0, zlat1, zlat2,   & !    "         " 
    408          zsdmp, zbdmp                   !    "         " 
    409       REAL(wp), DIMENSION(jpk) ::   & 
    410          zhfac 
    411       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    412          zmrs 
    413       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    414          zdct 
     342      REAL(wp) ::   zdate0, zinfl, zlon         ! temporary scalars 
     343      REAL(wp) ::   zlat, zlat0, zlat1, zlat2   !    "         " 
     344      REAL(wp) ::   zsdmp, zbdmp                !    "         " 
     345      REAL(wp), DIMENSION(jpk)         ::   zhfac 
     346      REAL(wp), DIMENSION(jpi,jpj)     ::   zmrs 
     347      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdct 
    415348      !!---------------------------------------------------------------------- 
    416349 
    … …  
    494427               DO ji = 1, jpi 
    495428                  zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) ) 
    496  
    497429                  !   ... Decrease the value in the vicinity of the coast 
    498                   resto(ji,jj,jk) = resto(ji,jj,1)*0.5   & 
    499                      &            * ( 1. - COS( rpi*zdct(ji,jj,jk)/zinfl) ) 
    500  
     430                  resto(ji,jj,jk) = resto(ji,jj,1) * 0.5 * ( 1. - COS( rpi*zdct(ji,jj,jk)/zinfl) ) 
    501431                  !   ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom) 
    502                   resto(ji,jj,jk) = resto(ji,jj,jk)   & 
    503                      &            * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/hdmp) ) 
     432                  resto(ji,jj,jk) = resto(ji,jj,jk)      * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/hdmp) ) 
    504433               END DO 
    505434            END DO 
    506435         END DO 
    507  
     436         ! 
    508437      ENDIF 
    509438 
    … …  
    524453         CASE ( 4 )                                  !  ORCA_R4 configuration  
    525454            !                                        ! ======================= 
    526  
    527455            ! Mediterranean Sea 
    528456            ij0 =  50   ;   ij1 =  56 
    … …  
    539467               zhfac (jk) = 1./rday 
    540468            END DO 
    541  
    542469            !                                        ! ======================= 
    543470         CASE ( 2 )                                  !  ORCA_R2 configuration  
    544471            !                                        ! ======================= 
    545  
    546472            ! Mediterranean Sea 
    547473            ij0 =  96   ;   ij1 = 110 
    … …  
    576502               zhfac (jk) = 1./rday 
    577503            END DO 
    578  
    579504            !                                        ! ======================= 
    580505         CASE ( 05 )                                 !  ORCA_R05 configuration 
    581506            !                                        ! ======================= 
    582  
    583507            ! Mediterranean Sea 
    584508            ii0 = 568   ;   ii1 = 574  
    … …  
    608532               zhfac (jk) = ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(1,1,jk)/hdmp) ) 
    609533            END DO 
    610  
    611534            !                                       ! ======================== 
    612535         CASE ( 025 )                               !  ORCA_R025 configuration  
    613536            !                                       ! ======================== 
    614537            CALL ctl_stop( ' Not yet implemented in ORCA_R025' ) 
    615  
     538            ! 
    616539         END SELECT 
    617540 
    … …  
    644567         CALL ymds2ju( 0     , 1      , 1      , 0.e0 , zdate0 ) 
    645568         CALL restini( 'NONE', jpi    , jpj    , glamt, gphit,    & 
    646                        jpk   , gdept_0, clname3, itime, zdate0,   & 
    647                        rdt   , idmp, domain_id=nidom ) 
     569            &          jpk   , gdept_0, clname3, itime, zdate0,   & 
     570            &          rdt   , idmp, domain_id=nidom ) 
    648571         CALL restput( idmp, 'Resto', jpi, jpj, jpk,   & 
    649                        0   , resto  ) 
     572            &          0   , resto  ) 
    650573         CALL restclo( idmp ) 
    651574      ENDIF 
    652  
     575      ! 
    653576   END SUBROUTINE dtacof 
    654577 
    … …  
    673596      !! ** Action  : - pdct, distance to the coastline (argument) 
    674597      !!              - NetCDF file 'dist.coast.nc'  
    675       !!         
    676       !! History : 
    677       !!   7.0  !  01-02  (M. Imbard)  Original code 
    678       !!   8.1  !  01-02  (G. Madec, E. Durand) 
    679       !!   8.5  !  02-08  (G. Madec, E. Durand)  Free form, F90 
    680       !!---------------------------------------------------------------------- 
    681       !! * Modules used 
    682       USE ioipsl 
    683  
    684       !! * Arguments 
    685       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    686          pdct                     ! distance to the coastline 
    687  
    688       !! * local declarations 
    689       INTEGER :: ji, jj, jk, jl      ! dummy loop indices 
    690       INTEGER :: iju, ijt            ! temporary integers 
    691       INTEGER :: icoast, itime 
    692       INTEGER ::   & 
    693          icot         ! logical unit for file distance to the coast 
    694       LOGICAL, DIMENSION(jpi,jpj) ::   & 
    695          llcotu, llcotv, llcotf   ! ??? 
     598      !!---------------------------------------------------------------------- 
     599      USE ioipsl      ! IOipsl librairy 
     600      !! 
     601      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline 
     602      !! 
     603      INTEGER ::   ji, jj, jk, jl      ! dummy loop indices 
     604      INTEGER ::   iju, ijt            ! temporary integers 
     605      INTEGER ::   icoast, itime 
     606      INTEGER ::   icot         ! logical unit for file distance to the coast 
     607      LOGICAL, DIMENSION(jpi,jpj) ::   llcotu, llcotv, llcotf   ! ??? 
    696608      CHARACTER (len=32) ::   clname 
    697609      REAL(wp) ::   zdate0 
    698       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    699          zxt, zyt, zzt,                 &  ! cartesian coordinates for T-points 
    700          zmask                              
    701       REAL(wp), DIMENSION(3*jpi*jpj) ::   & 
    702          zxc, zyc, zzc, zdis      ! temporary workspace 
     610      REAL(wp), DIMENSION(jpi,jpj)   ::   zxt, zyt, zzt, zmask   ! cartesian coordinates for T-points 
     611      REAL(wp), DIMENSION(3*jpi*jpj) ::   zxc, zyc, zzc, zdis    ! temporary workspace 
    703612      !!---------------------------------------------------------------------- 
    704613 
    … …  
    832741                  DO jl = 1, icoast 
    833742                     zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2   & 
    834                               + ( zyt(ji,jj) - zyc(jl) )**2   & 
    835                               + ( zzt(ji,jj) - zzc(jl) )**2 
     743                        &     + ( zyt(ji,jj) - zyc(jl) )**2   & 
     744                        &     + ( zzt(ji,jj) - zzc(jl) )**2 
    836745                  END DO 
    837746                  pdct(ji,jj,jk) = ra * SQRT( MINVAL( zdis(1:icoast) ) ) 
    … …  
    850759      CALL ymds2ju( 0     , 1      , 1     , 0.e0 , zdate0 ) 
    851760      CALL restini( 'NONE', jpi    , jpj   , glamt, gphit ,   & 
    852                     jpk   , gdept_0, clname, itime, zdate0,   & 
    853                     rdt   , icot                         ) 
     761         &          jpk   , gdept_0, clname, itime, zdate0,   & 
     762         &          rdt   , icot                         ) 
    854763      CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct ) 
    855764      CALL restclo( icot ) 

  • trunk/NEMO/OPA_SRC/TRA/traldf.F90

    r474 r503  
    44   !! Ocean Active tracers : lateral diffusive trends  
    55   !!===================================================================== 
    6    !! History : 
    7    !!   9.0  !  05-11  (G. Madec)  Original code 
     6   !! History :  9.0  ! 05-11 (G. Madec)  Original code 
     7   !!---------------------------------------------------------------------- 
     8 
    89   !!---------------------------------------------------------------------- 
    910   !!   tra_ldf     : update the tracer trend with the lateral diffusion 
    … …  
    1112   !!       ldf_ano : compute lateral diffusion for constant T-S profiles 
    1213   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1414   USE oce             ! ocean dynamics and tracers 
    1515   USE dom_oce         ! ocean space and time domain 
    … …  
    3131   PRIVATE 
    3232 
    33    !! *  Routine accessibility 
    34    PUBLIC tra_ldf      ! called by step.F90  
    35  
    36    !! * module variables 
    37    INTEGER ::                        &  
    38       nldf = 0                         ! type of lateral diffusion used 
    39       !                                ! defined from ln_traldf_... namlist logicals) 
     33   PUBLIC   tra_ldf    ! called by step.F90  
     34 
     35   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 
    4036#if defined key_traldf_ano 
    41    REAL, DIMENSION(jpi,jpj,jpk) ::   &   
    42       t0_ldf, s0_ldf                    ! lateral diffusion trends of T & S 
    43       !                                 ! for a constant vertical profile 
     37   REAL, DIMENSION(jpi,jpj,jpk) ::   t0_ldf, s0_ldf   ! lateral diffusion trends of T & S 
     38      !                                               ! for a constant vertical profile 
    4439#endif 
    4540 
    … …  
    4742#  include "domzgr_substitute.h90" 
    4843#  include "vectopt_loop_substitute.h90" 
    49    !!--------------------------------------------------------------------------------- 
    50    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    51    !!--------------------------------------------------------------------------------- 
     44   !!---------------------------------------------------------------------- 
     45   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     46   !! $Header$  
     47   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     48   !!---------------------------------------------------------------------- 
    5249 
    5350CONTAINS 
    … …  
    6057      !! 
    6158      !!---------------------------------------------------------------------- 
    62       !! * Arguments 
    63       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    64  
    65       !! * local declarations 
    66       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    67          ztrdt, ztrds                         ! 3D temporary workspace 
    68       !!---------------------------------------------------------------------- 
    69  
    70       IF( kt == nit000 )   CALL ldf_ctl      ! initialisation & control of options 
     59      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     60      !! 
     61      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt, ztrds   ! 3D temporary workspace 
     62      !!---------------------------------------------------------------------- 
     63 
     64      IF( kt == nit000 )   CALL ldf_ctl          ! initialisation & control of options 
    7165 
    7266      IF( l_trdtra )   THEN                      ! temporary save of ta and sa trends 
    … …  
    7670 
    7771      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    78       CASE ( -1 )                                       ! esopa: test all possibility with control print 
     72      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt )      ! iso-level laplacian 
     73      CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt )      ! rotated laplacian (except dk[ dk[.] ] part) 
     74      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt )      ! iso-level bilaplacian 
     75      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt )      ! s-coord. horizontal bilaplacian 
     76         ! 
     77      CASE ( -1 )                                     ! esopa: test all possibility with control print 
    7978         CALL tra_ldf_lap    ( kt ) 
    8079         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf0 - Ta: ', mask1=tmask,               & 
    … …  
    8988         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf3 - Ta: ', mask1=tmask,               & 
    9089            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    91  
    92       CASE ( 0 )                                       ! iso-level laplacian 
    93          CALL tra_ldf_lap    ( kt ) 
    94       CASE ( 1 )                                       ! rotated laplacian (except dk[ dk[.] ] part) 
    95          CALL tra_ldf_iso    ( kt ) 
    96       CASE ( 2 )                                       ! iso-level bilaplacian 
    97          CALL tra_ldf_bilap  ( kt ) 
    98       CASE ( 3 )                                       ! s-coord. horizontal bilaplacian 
    99          CALL tra_ldf_bilapg ( kt ) 
    10090      END SELECT 
    10191 
    10292#if defined key_traldf_ano 
    103       !                                          ! anomaly: substract the reference diffusivity 
    104       ta(:,:,:) = ta(:,:,:) - t0_ldf(:,:,:) 
     93      ta(:,:,:) = ta(:,:,:) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity 
    10594      sa(:,:,:) = sa(:,:,:) - s0_ldf(:,:,:) 
    10695#endif 
    107  
    108       !                                          ! save the horizontal diffusive trends for further diagnostics 
    109       IF( l_trdtra )   THEN 
     96      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    11097         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    11198         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    112          CALL trd_mod( ztrdt, ztrds, jpttdldf, 'TRA', kt ) 
    113       ENDIF 
    114  
     99         CALL trd_mod( ztrdt, ztrds, jptra_trd_ldf, 'TRA', kt ) 
     100      ENDIF 
    115101      !                                          ! print mean trends (used for debugging) 
    116102      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf  - Ta: ', mask1=tmask,               & 
    117103         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    118  
     104      ! 
    119105   END SUBROUTINE tra_ldf 
    120106 
    … …  
    132118      !!      nldf ==  2   bilaplacian operator 
    133119      !!      nldf ==  3   Rotated bilaplacian 
    134       !! 
    135       !!---------------------------------------------------------------------- 
    136       !! * Local declarations 
     120      !!---------------------------------------------------------------------- 
    137121      INTEGER ::   ioptio, ierr         ! temporary integers  
    138122!       
    … …  
    150134!     READ  ( numnam, nam_traldf ) 
    151135 
    152       IF(lwp) THEN 
     136      IF(lwp) THEN                    ! Namelist print 
    153137         WRITE(numout,*) 
    154138         WRITE(numout,*) 'tra:ldf_ctl : lateral tracer diffusive operator' 
    155139         WRITE(numout,*) '~~~~~~~~~~~' 
    156          WRITE(numout,*) '          Namelist nam_traldf : set lateral mixing parameters (type, direction, coefficients)' 
    157          WRITE(numout,*) '             laplacian operator          ln_traldf_lap   = ', ln_traldf_lap 
    158          WRITE(numout,*) '             bilaplacian operator        ln_traldf_bilap = ', ln_traldf_bilap 
    159          WRITE(numout,*) '             iso-level                   ln_traldf_level = ', ln_traldf_level 
    160          WRITE(numout,*) '             horizontal (geopotential)   ln_traldf_hor   = ', ln_traldf_hor 
    161          WRITE(numout,*) '             iso-neutral                 ln_traldf_iso   = ', ln_traldf_iso 
    162       ENDIF 
    163  
    164       ! Parameter control 
    165  
    166       ! control the input 
     140         WRITE(numout,*) '       Namelist nam_traldf : set lateral mixing parameters (type, direction, coefficients)' 
     141         WRITE(numout,*) '          laplacian operator          ln_traldf_lap   = ', ln_traldf_lap 
     142         WRITE(numout,*) '          bilaplacian operator        ln_traldf_bilap = ', ln_traldf_bilap 
     143         WRITE(numout,*) '          iso-level                   ln_traldf_level = ', ln_traldf_level 
     144         WRITE(numout,*) '          horizontal (geopotential)   ln_traldf_hor   = ', ln_traldf_hor 
     145         WRITE(numout,*) '          iso-neutral                 ln_traldf_iso   = ', ln_traldf_iso 
     146      ENDIF 
     147 
     148      !                               ! control the input 
    167149      ioptio = 0 
    168150      IF( ln_traldf_lap   )   ioptio = ioptio + 1 
    169151      IF( ln_traldf_bilap )   ioptio = ioptio + 1 
    170       IF( ioptio /= 1 ) CALL ctl_stop( '          use ONE of the 2 lap/bilap operator type on tracer' ) 
     152      IF( ioptio /= 1 )   CALL ctl_stop( '          use ONE of the 2 lap/bilap operator type on tracer' ) 
    171153      ioptio = 0 
    172154      IF( ln_traldf_level )   ioptio = ioptio + 1 
    173155      IF( ln_traldf_hor   )   ioptio = ioptio + 1 
    174156      IF( ln_traldf_iso   )   ioptio = ioptio + 1 
    175       IF( ioptio /= 1 ) CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
     157      IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
    176158 
    177159      ! defined the type of lateral diffusion from ln_traldf_... logicals 
    … …  
    213195      ENDIF 
    214196 
    215       IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    216       IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
    217       IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso ) & 
    218            & CALL ctl_stop( '          eddy induced velocity on tracers', & 
    219            &                ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
     197      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
     198      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
     199      IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   & 
     200           CALL ctl_stop( '          eddy induced velocity on tracers',  & 
     201           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
    220202      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    221          IF( .NOT.lk_ldfslp ) CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' ) 
     203         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' ) 
    222204      ENDIF 
    223205 
    … …  
    236218      ENDIF 
    237219 
    238  
    239220      ! Reference T & S diffusivity (if necessary) 
    240221      ! =========================== 
    241  
    242222      CALL ldf_ano 
    243  
     223      ! 
    244224   END SUBROUTINE ldf_ctl 
    245225 
    … …  
    254234      !! 
    255235      !! ** Purpose :   initializations of  
    256       !! 
    257       !!---------------------------------------------------------------------- 
    258       !! * Modules used 
     236      !!---------------------------------------------------------------------- 
    259237      USE zdf_oce         ! vertical mixing 
    260238      USE trazdf          ! vertical mixing: double diffusion 
    261239      USE zdfddm          ! vertical mixing: double diffusion 
    262  
    263       !! * local declarations 
    264       INTEGER  ::   jk                         ! Dummy loop indice 
    265       LOGICAL  ::   llsave                     ! 
    266       REAL(wp) ::   zt0, zs0, z12              ! temporary scalar 
    267       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    268          zt_ref, ztb, zavt,                 &  ! 3D temporary workspace 
    269          zs_ref, zsb                           ! 3D temporary workspace 
     240      !! 
     241      INTEGER  ::   jk              ! Dummy loop indice 
     242      LOGICAL  ::   llsave          ! 
     243      REAL(wp) ::   zt0, zs0, z12   ! temporary scalar 
     244      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zt_ref, ztb, zavt   ! 3D workspace 
     245      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zs_ref, zsb         ! 3D workspace 
    270246      !!---------------------------------------------------------------------- 
    271247 
    … …  
    329305      sa    (:,:,:) = va  (:,:,:) 
    330306      avt   (:,:,:) = zavt(:,:,:) 
    331  
     307      ! 
    332308   END SUBROUTINE ldf_ano 
    333309 

  • trunk/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r457 r503  
    11MODULE traldf_iso 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                   ***  MODULE  traldf_iso  *** 
    44   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend 
    5    !!============================================================================== 
     5   !!====================================================================== 
     6   !! History :        !  94-08  (G. Madec, M. Imbard) 
     7   !!                  !  97-05  (G. Madec)  split into traldf and trazdf 
     8   !!             8.5  !  02-08  (G. Madec)  Free form, F90 
     9   !!             9.0  !  05-11  (G. Madec)  merge traldf and trazdf :-) 
     10   !!---------------------------------------------------------------------- 
    611#if   defined key_ldfslp   ||   defined key_esopa 
    712   !!---------------------------------------------------------------------- 
    813   !!   'key_ldfslp'               slope of the lateral diffusive direction 
     14   !!---------------------------------------------------------------------- 
    915   !!---------------------------------------------------------------------- 
    1016   !!   tra_ldf_iso  : update the tracer trend with the horizontal  
    … …  
    1420   !!                  vector optimization, use k-j-i loops. 
    1521   !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    1722   USE oce             ! ocean dynamics and active tracers 
    1823   USE dom_oce         ! ocean space and time domain 
    … …  
    2631   USE prtctl          ! Print control 
    2732 
    28  
    2933   IMPLICIT NONE 
    3034   PRIVATE 
    3135 
    32    !! * Accessibility 
    33    PUBLIC tra_ldf_iso   ! routine called by step.F90 
     36   PUBLIC   tra_ldf_iso   ! routine called by step.F90 
    3437 
    3538   !! * Substitutions 
    … …  
    3942   !!---------------------------------------------------------------------- 
    4043   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     44   !! $Header$  
     45   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4146   !!---------------------------------------------------------------------- 
    4247 
    … …  
    8186      !!         ta = ta + difft 
    8287      !! 
    83       !! ** Action : 
    84       !!         Update (ta,sa) arrays with the before rotated diffusion trend 
    85       !!            (except the dk[ dk[.] ] term) 
    86       !! 
    87       !! History : 
    88       !!        !  94-08  (G. Madec, M. Imbard) 
    89       !!        !  97-05  (G. Madec)  split into traldf and trazdf 
    90       !!   8.5  !  02-08  (G. Madec)  Free form, F90 
    91       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    92       !!        !  05-11  (G. Madec)  merge traldf and trazdf :-) 
    93       !!---------------------------------------------------------------------- 
    94       !! * Modules used 
    95       USE oce           , zftv => ua,   &  ! use ua as workspace 
    96          &                zfsv => va       ! use va as workspace 
    97  
    98       !! * Arguments 
    99       INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
    100  
    101       !! * Local declarations 
    102       INTEGER ::   ji, jj, jk              ! dummy loop indices 
    103       INTEGER ::   iku, ikv                ! temporary integer 
    104       REAL(wp) ::   & 
    105          zabe1, zabe2, zcof1, zcof2,    &  ! temporary scalars 
    106          zmsku, zta,                    &  !    "           " 
    107          zmskv, zsa, zbtr,              &  !    "           " 
    108          zcoef0, zcoef3, zcoef4            !    "         " 
    109       REAL(wp), DIMENSION(jpi,jpj) ::   &  ! temporary workspace 
    110          zdkt , zdk1t, zftu,            &  !    "           " 
    111          zdks , zdk1s, zfsu                !    "           " 
    112       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &  
    113          zdit, zdjt, ztfw,              &  ! temporary workspace 
    114          zdis, zdjs, zsfw                  !    "           " 
     88      !! ** Action :   Update (ta,sa) arrays with the before rotated diffusion 
     89      !!            trend (except the dk[ dk[.] ] term) 
     90      !!---------------------------------------------------------------------- 
     91      USE oce           , zftv => ua   ! use ua as workspace 
     92      USE oce           , zfsv => va   ! use va as workspace 
     93      !! 
     94      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
     95      !! 
     96      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     97      INTEGER  ::   iku, ikv     ! temporary integer 
     98      REAL(wp) ::   zmsku, zabe1, zcof1, zcoef3, zta   ! temporary scalars 
     99      REAL(wp) ::   zmskv, zabe2, zcof2, zcoef4, zsa   !    "         " 
     100      REAL(wp) ::   zcoef0, zbtr                       !    "         " 
     101      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt , zdk1t, zftu   ! 2D workspace 
     102      REAL(wp), DIMENSION(jpi,jpj)     ::   zdks , zdk1s, zfsu   !    "           " 
     103      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw     ! 3D workspace 
     104      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdis, zdjs, zsfw     !  "      " 
    115105      !!---------------------------------------------------------------------- 
    116106 
    … …  
    130120      zdjs (1,:,:) = 0.e0     ;     zdjs (jpi,:,:) = 0.e0 
    131121!!end 
    132  
    133122 
    134123      ! Horizontal temperature and salinity gradient  
    … …  
    217206         ! II.4 Second derivative (divergence) and add to the general trend 
    218207         ! ---------------------------------------------------------------- 
    219  
    220208         DO jj = 2 , jpjm1 
    221209            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    231219      !                                             ! =============== 
    232220 
    233       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    234          ! "zonal" mean lateral diffusive heat and salt transports 
     221      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   ! Poleward diffusive heat and salt transports 
    235222         pht_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    236223         pst_ldf(:) = ptr_vj( zfsv(:,:,:) ) 
    … …  
    297284         END DO 
    298285      END DO 
    299  
     286      ! 
    300287   END SUBROUTINE tra_ldf_iso 
    301288 
    … …  
    306293CONTAINS 
    307294   SUBROUTINE tra_ldf_iso( kt )               ! Empty routine 
    308       INTEGER :: kt 
    309295      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt 
    310296   END SUBROUTINE tra_ldf_iso 

  • trunk/NEMO/OPA_SRC/TRA/tranpc.F90

    r247 r503  
    44   !! Ocean active tracers:  non penetrative convection scheme 
    55   !!============================================================================== 
     6   !! History :  1.0  !  90-09  (G. Madec)  Original code 
     7   !!                 !  91-11  (G. Madec) 
     8   !!                 !  92-06  (M. Imbard)  periodic conditions on t and s 
     9   !!                 !  93-03  (M. Guyon)  symetrical conditions  
     10   !!                 !  96-01  (G. Madec)  statement function for e3 
     11   !!                                       suppression of common work arrays 
     12   !!            8.5  !  02-06  (G. Madec)  free form F90 
     13   !!---------------------------------------------------------------------- 
    614 
    715   !!---------------------------------------------------------------------- 
    … …  
    917   !!   tra_npc_init : initialization and control of the scheme 
    1018   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1219   USE oce             ! ocean dynamics and active tracers  
    1320   USE dom_oce         ! ocean space and time domain 
    … …  
    2128   PRIVATE 
    2229 
    23    !! * Routine accessibility 
    24    PUBLIC tra_npc      ! routine called by step.F90 
    25  
    26    !! * Module variable 
    27    INTEGER ::       & 
    28       nnpc1 =   1,  &  ! nnpc1   non penetrative convective scheme frequency 
    29       nnpc2 =  15      ! nnpc2   non penetrative convective scheme print frequency 
     30   PUBLIC   tra_npc    ! routine called by step.F90 
     31 
     32   !!* Namelist namnpc: non penetrative convection algorithm 
     33   INTEGER ::   nnpc1 =   1   ! nnpc1   non penetrative convective scheme frequency 
     34   INTEGER ::   nnpc2 =  15   ! nnpc2   non penetrative convective scheme print frequency 
     35   NAMELIST/namnpc/ nnpc1, nnpc2 
    3036 
    3137   !! * Substitutions 
    … …  
    3440   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    3541   !! $Header$  
    36    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     42   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3743   !!---------------------------------------------------------------------- 
    3844 
    … …  
    5056      !!      iterations. instabilities are treated when the vertical density 
    5157      !!      gradient is less than 1.e-5. 
    52       !! 
    53       !!      'key_trdtra' defined: the trend associated with this 
    54       !!                               algorithm is saved. 
    55       !! 
    56       !!      macro-tasked on vertical slab (jj-loop) 
     58      !!      l_trdtra=T: the trend associated with this algorithm is saved. 
    5759      !! 
    5860      !! ** Action  : - (tn,sn) after the application od the npc scheme 
    5961      !!              - save the associated trends (ttrd,strd) ('key_trdtra') 
    6062      !! 
    61       !! References : 
    62       !!      Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
    63       !! 
    64       !! History : 
    65       !!   1.0  !  90-09  (G. Madec)  Original code 
    66       !!        !  91-11  (G. Madec) 
    67       !!        !  92-06  (M. Imbard)  periodic conditions on t and s 
    68       !!        !  93-03  (M. Guyon)  symetrical conditions  
    69       !!        !  96-01  (G. Madec)  statement function for e3 
    70       !!                                  suppression of common work arrays 
    71       !!   8.5  !  02-06  (G. Madec)  free form F90 
    72       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    73       !!---------------------------------------------------------------------- 
    74       !! * Modules used      
    75       USE oce, ONLY :    ztdta => ua,   & ! use ua as 3D workspace    
    76                          ztdsa => va      ! use va as 3D workspace    
    77  
    78       !! * Arguments 
    79       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    80  
    81       !! * Local declarations 
    82       INTEGER ::   ji, jj, jk             ! dummy loop indices 
    83       INTEGER ::   & 
    84          inpcc ,                        & ! number of statically instable water column 
    85          inpci ,                        & ! number of iteration for npc scheme 
    86          jiter, jkdown, jkp,            & ! ??? 
    87          ikbot, ik, ikup, ikdown          ! ??? 
    88       REAL(wp) ::   &                     ! temporary arrays 
    89          ze3tot, zta, zsa, zraua, ze3dwn 
    90       REAL(wp), DIMENSION(jpi,jpk) ::   & 
    91          zwx, zwy, zwz                    ! temporary arrays 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    93          zrhop                            ! temporary arrays 
    94       !!---------------------------------------------------------------------- 
    95  
    96       IF( kt == nit000  )   CALL tra_npc_init 
    97  
     63      !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
     64      !!---------------------------------------------------------------------- 
     65      USE oce, ONLY :    ztrdt => ua   ! use ua as 3D workspace    
     66      USE oce, ONLY :    ztrds => va   ! use va as 3D workspace    
     67      !!  
     68      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     69      !! 
     70      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     71      INTEGER  ::   inpcc        ! number of statically instable water column 
     72      INTEGER  ::   inpci        ! number of iteration for npc scheme 
     73      INTEGER  ::   jiter, jkdown, jkp        ! ??? 
     74      INTEGER  ::   ikbot, ik, ikup, ikdown   ! ??? 
     75      REAL(wp) ::   ze3tot, zta, zsa, zraua, ze3dwn 
     76      REAL(wp), DIMENSION(jpi,jpk)     ::   zwx, zwy, zwz   ! 2D arrays 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhop           ! 3D arrays 
     78      !!---------------------------------------------------------------------- 
     79 
     80      IF( kt == nit000  )   CALL tra_npc_init   ! Initialisation 
    9881 
    9982      IF( MOD( kt, nnpc1 ) == 0 ) THEN 
    … …  
    10285         inpci = 0 
    10386 
    104          ! 0. Potential density 
    105          ! -------------------- 
    106  
    107          CALL eos( tn, sn, rhd, zrhop ) 
    108  
    109          ! Save tn and sn trends 
    110          IF( l_trdtra )   THEN 
    111             ztdta(:,:,:) = tn(:,:,:)  
    112             ztdsa(:,:,:) = sn(:,:,:)  
     87         CALL eos( tn, sn, rhd, zrhop )         ! Potential density 
     88 
     89 
     90         IF( l_trdtra )   THEN                  ! Save tn and sn trends 
     91            ztrdt(:,:,:) = tn(:,:,:)  
     92            ztrds(:,:,:) = sn(:,:,:)  
    11393         ENDIF 
    11494 
    … …  
    11696         DO jj = 1, jpj                                   !  Vertical slab 
    11797            !                                             ! =============== 
    118  
    119             ! 1. Static instability pointer  
    120             ! ----------------------------- 
    121  
     98            !  Static instability pointer  
     99            ! ---------------------------- 
    122100            DO jk = 1, jpkm1 
    123101               DO ji = 1, jpi 
    … …  
    134112            END DO 
    135113            ! even if south-symmetric b. c. used, do not considere jj=1 
    136             IF( jj == 1 ) zwx(:,:) = 0.e0 
     114            IF( jj == 1 )   zwx(:,:) = 0.e0 
    137115 
    138116            DO jk = 1, jpkm1 
    139117               DO ji = 1, jpi 
    140118                  zwx(ji,jk) = 1. 
    141                   IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk)=0. 
    142                END DO 
    143             END DO 
    144  
    145             zwy(:,1) = 0. 
     119                  IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk) = 0.e0 
     120               END DO 
     121            END DO 
     122 
     123            zwy(:,1) = 0.e0 
    146124            DO ji = 1, jpi 
    147125               DO jk = 1, jpkm1 
    … …  
    150128            END DO 
    151129 
    152             zwz(1,1) = 0. 
     130            zwz(1,1) = 0.e0 
    153131            DO ji = 1, jpi 
    154132               zwz(1,1) = zwz(1,1) + zwy(ji,1) 
    … …  
    161139            ! ------------------------------------------------------------------ 
    162140 
    163             IF (zwz(1,1) /= 0.) THEN 
    164  
    165                ! -->> the density profil is statically instable : 
    166  
     141            IF( zwz(1,1) /= 0.e0 ) THEN         ! -->> the density profil is statically instable : 
    167142               DO ji = 1, jpi 
    168                   IF( zwy(ji,1) /= 0. ) THEN 
    169  
    170                      ! ikbot: ocean bottom level 
    171  
    172                      ikbot = mbathy(ji,jj) 
    173  
    174                      ! vertical iteration 
    175  
    176                      DO jiter = 1, jpk 
    177  
     143                  IF( zwy(ji,1) /= 0.e0 ) THEN 
     144                     ! 
     145                     ikbot = mbathy(ji,jj)      ! ikbot: ocean bottom level 
     146                     ! 
     147                     DO jiter = 1, jpk          ! vertical iteration 
     148                        ! 
    178149                        ! search of ikup : the first static instability from the sea surface 
    179  
     150                        ! 
    180151                        ik = 0 
    181152220                     CONTINUE 
    … …  
    183154                        IF( ik >= ikbot-1 ) GO TO 200 
    184155                        zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1) 
    185                         IF( zwx(ji,ik) <= 0. ) GO TO 220 
     156                        IF( zwx(ji,ik) <= 0.e0 ) GO TO 220 
    186157                        ikup = ik 
    187158                        ! the density profil is instable below ikup 
    188     
    189159                        ! ikdown : bottom of the instable portion of the density profil 
    190  
    191160                        ! search of ikdown and vertical mixing from ikup to ikdown 
    192  
     161                        ! 
    193162                        ze3tot= fse3t(ji,jj,ikup) 
    194163                        zta   = tn   (ji,jj,ikup) 
    195164                        zsa   = sn   (ji,jj,ikup) 
    196165                        zraua = zrhop(ji,jj,ikup) 
    197  
     166                        ! 
    198167                        DO jkdown = ikup+1, ikbot-1 
    199168                           IF( zraua <= zrhop(ji,jj,jkdown) ) THEN 
    … …  
    210179                        ikdown = ikbot-1 
    211180240                     CONTINUE 
    212  
     181                        ! 
    213182                        DO jkp = ikup, ikdown-1 
    214183                           tn(ji,jj,jkp) = zta 
    … …  
    221190                           zrhop(ji,jj,ikdown) = zraua 
    222191                        ENDIF 
    223  
    224192                     END DO 
    225193                  ENDIF 
    226194200               CONTINUE 
    227195               END DO 
    228  
    229196               ! <<-- no more static instability on slab jj 
    230  
    231197            ENDIF 
    232198            !                                             ! =============== 
    233199         END DO                                           !   End of slab 
    234200         !                                                ! =============== 
    235  
    236  
    237          ! save the trends for diagnostic 
    238          ! Non penetrative mixing trends 
    239          IF( l_trdtra )   THEN 
    240             ztdta(:,:,:) = tn(:,:,:) - ztdta(:,:,:) 
    241             ztdsa(:,:,:) = sn(:,:,:) - ztdsa(:,:,:) 
    242  
    243             CALL trd_mod(ztdta, ztdsa, jpttdnpc, 'TRA', kt) 
     201         !  
     202         IF( l_trdtra )   THEN         ! save the Non penetrative mixing trends for diagnostic 
     203            ztrdt(:,:,:) = tn(:,:,:) - ztrdt(:,:,:) 
     204            ztrds(:,:,:) = sn(:,:,:) - ztrds(:,:,:) 
     205            CALL trd_mod(ztrdt, ztrds, jptra_trd_npc, 'TRA', kt) 
    244206         ENDIF 
    245207       
    … …  
    252214         !  2. non penetrative convective scheme statistics 
    253215         !  ----------------------------------------------- 
    254  
    255216         IF( nnpc2 /= 0 .AND. MOD( kt, nnpc2 ) == 0 ) THEN 
    256217            IF(lwp) WRITE(numout,*)' kt=',kt, ' number of statically instable',   & 
    257                ' water column : ',inpcc, ' number of iteration : ',inpci 
     218               &                   ' water column : ',inpcc, ' number of iteration : ',inpci 
    258219         ENDIF 
    259  
     220         ! 
    260221      ENDIF 
    261        
     222      ! 
    262223   END SUBROUTINE tra_npc 
    263224 
    … …  
    268229      !!                    
    269230      !! ** Purpose :   initializations of the non-penetrative adjustment scheme 
    270       !! 
    271       !! History : 
    272       !!   8.5  !  02-12  (G. Madec)  F90 : free form 
    273       !!---------------------------------------------------------------------- 
    274       !! * Namelist 
    275       NAMELIST/namnpc/ nnpc1, nnpc2 
    276       !!---------------------------------------------------------------------- 
    277  
    278       ! Namelist namzdf : vertical diffusion 
    279       REWIND( numnam ) 
     231      !!---------------------------------------------------------------------- 
     232      ! 
     233      REWIND( numnam )           ! Namelist namzdf : vertical diffusion 
    280234      READ  ( numnam, namnpc ) 
    281  
    282       ! Parameter print 
    283       ! --------------- 
    284       IF(lwp) THEN 
     235      ! 
     236      IF(lwp) THEN               ! Namelist print 
    285237         WRITE(numout,*) 
    286238         WRITE(numout,*) 'tra_npc_init : Non Penetrative Convection (npc) scheme' 
    287239         WRITE(numout,*) '~~~~~~~~~~~~' 
    288          WRITE(numout,*) '          Namelist namnpc : set npc scheme parameters' 
    289          WRITE(numout,*) 
    290          WRITE(numout,*) '             npc scheme frequency           nnpc1  = ', nnpc1 
    291          WRITE(numout,*) '             npc scheme print frequency     nnpc2  = ', nnpc2 
    292          WRITE(numout,*) 
     240         WRITE(numout,*) '       Namelist namnpc : set npc scheme parameters' 
     241         WRITE(numout,*) '          npc scheme frequency           nnpc1  = ', nnpc1 
     242         WRITE(numout,*) '          npc scheme print frequency     nnpc2  = ', nnpc2 
    293243      ENDIF 
    294  
    295  
    296       ! Parameter controls 
    297       ! ------------------ 
    298       IF ( nnpc1 == 0 ) THEN 
     244      ! 
     245      IF ( nnpc1 == 0 ) THEN      ! Parameter controls 
    299246          IF(lwp) WRITE(numout,cform_war) 
    300247          IF(lwp) WRITE(numout,*) '             nnpc1 = ', nnpc1, ' is forced to 1' 
    … …  
    302249          nwarn = nwarn + 1 
    303250      ENDIF 
    304        
     251      ! 
    305252   END SUBROUTINE tra_npc_init 
    306253 

  • trunk/NEMO/OPA_SRC/TRA/tranxt.F90

    r457 r503  
    44   !! Ocean active tracers:  time stepping on temperature and salinity 
    55   !!====================================================================== 
    6    !! History : 
    7    !!   7.0  !  91-11  (G. Madec)  Original code 
    8    !!        !  93-03  (M. Guyon)  symetrical conditions 
    9    !!        !  96-02  (G. Madec & M. Imbard)  opa release 8.0 
    10    !!   8.0  !  96-04  (A. Weaver)  Euler forward step 
    11    !!   8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad. 
    12    !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    13    !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries 
    14    !!   9.0  !  06-02  (L. Debreu, C. Mazauric) Agrif implementation 
     6   !! History :  7.0  !  91-11  (G. Madec)  Original code 
     7   !!                 !  93-03  (M. Guyon)  symetrical conditions 
     8   !!                 !  96-02  (G. Madec & M. Imbard)  opa release 8.0 
     9   !!            8.0  !  96-04  (A. Weaver)  Euler forward step 
     10   !!            8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad. 
     11   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     12   !!                 !  02-11  (C. Talandier, A-M Treguier) Open boundaries 
     13   !!                 !  05-04  (C. Deltel) Add Asselin trend in the ML budget 
     14   !!            9.0  !  06-02  (L. Debreu, C. Mazauric) Agrif implementation 
     15   !!---------------------------------------------------------------------- 
     16 
    1517   !!---------------------------------------------------------------------- 
    1618   !!   tra_nxt     : time stepping on temperature and salinity 
    1719   !!---------------------------------------------------------------------- 
    18    !! * Modules used 
    1920   USE oce             ! ocean dynamics and tracers variables 
    2021   USE dom_oce         ! ocean space and time domain variables  
    … …  
    2324   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2425   USE obctra          ! open boundary condition (obc_tra routine) 
     26   USE trdmod          ! ocean active tracers trends  
     27   USE trdmod_oce      ! ocean variables trends 
    2528   USE prtctl          ! Print control 
    2629   USE agrif_opa_update 
    … …  
    3134 
    3235   !! * Routine accessibility 
    33    PUBLIC tra_nxt          ! routine called by step.F90 
    34    !!---------------------------------------------------------------------- 
    35    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     36   PUBLIC   tra_nxt   ! routine called by step.F90 
     37   !!---------------------------------------------------------------------- 
     38   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    3639   !! $Header$  
    37    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     40   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3841   !!---------------------------------------------------------------------- 
    3942 
    … …  
    6770      !! ** Action  : - update (tb,sb) and (tn,sn)  
    6871      !!              - (ta,sa) time averaged (t,s)      (ln_dynhpg_imp = T) 
    69       !! 
    7072      !!---------------------------------------------------------------------- 
    71       !! * Arguments 
    72       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    73  
    74       !! * Local declarations 
    75       INTEGER ::   ji, jj, jk   ! dummy loop indices 
    76       REAL(wp) ::   zt, zs      ! temporary scalars 
    77       REAL(wp) ::   zfact       ! temporary scalar 
     73      USE oce, ONLY :    ztrdt => ua   ! use ua as 3D workspace    
     74      USE oce, ONLY :    ztrds => va   ! use va as 3D workspace    
     75      !! 
     76      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     77      !! 
     78      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     79      REAL(wp) ::   zt, zs       ! temporary scalars 
     80      REAL(wp) ::   zfact        ! temporary scalar 
    7881      !!---------------------------------------------------------------------- 
    7982 
    80  
     83      IF( l_trdtra ) THEN 
     84         ztrdt(:,:,jpk) = 0.e0 
     85         ztrds(:,:,jpk) = 0.e0 
     86      ENDIF 
    8187      ! 0. Lateral boundary conditions on ( ta, sa )   (T-point, unchanged sign) 
    8288      ! ---------------------------------============ 
    … …  
    8490      CALL lbc_lnk( sa, 'T', 1. ) 
    8591 
    86  
    8792      !                                                ! =============== 
    8893      DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    9398         IF( ln_zdfexp ) THEN 
    9499            zfact = 2. * rdttra(jk) 
    95             IF( neuler == 0 .AND. kt == nit000 ) zfact = rdttra(jk) 
     100            IF( neuler == 0 .AND. kt == nit000 )   zfact = rdttra(jk) 
    96101            ta(:,:,jk) = ( tb(:,:,jk) + zfact * ta(:,:,jk) ) * tmask(:,:,jk) 
    97102            sa(:,:,jk) = ( sb(:,:,jk) + zfact * sa(:,:,jk) ) * tmask(:,:,jk) 
     103            IF(l_trdtra)   CALL ctl_stop( 'tranxt: Asselin ML trend not yet accounted for.' ) 
    98104         ENDIF 
    99105 
    … …  
    102108      END DO                                           !   End of slab 
    103109      !                                                ! =============== 
    104  
    105110      ! Update tracers on open boundaries. 
    106111      CALL obc_tra( kt ) 
    107  
    108112      !                                                ! =============== 
    109113      DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    114118      END DO                                           !   End of slab 
    115119      !                                                ! =============== 
    116  
    117120      ! Update tracers on open boundaries. 
    118121      CALL Agrif_tra( kt ) 
    119  
    120122      !                                                ! =============== 
    121123      DO jk = 1, jpkm1                                 ! Horizontal slab 
    122124         !                                             ! =============== 
    123125#endif 
    124  
    125  
    126126         ! 2. Time filter and swap of arrays 
    127127         ! --------------------------------- 
    … …  
    141141                  END DO 
    142142               END DO 
     143               IF( l_trdtra ) THEN 
     144                  ztrdt(:,:,jk) = 0.e0 
     145                  ztrds(:,:,jk) = 0.e0 
     146               END IF 
    143147            ELSE 
    144148               DO jj = 1, jpj 
    … …  
    148152                     tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk) 
    149153                     sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk) 
     154                     IF( l_trdtra ) THEN ! ChD ceci est a optimiser, mais ca marche 
     155                        ztrdt(ji,jj,jk) = tb(ji,jj,jk) - tn(ji,jj,jk) 
     156                        ztrds(ji,jj,jk) = sb(ji,jj,jk) - sn(ji,jj,jk) 
     157                     END IF 
    150158                     tn(ji,jj,jk) = ta(ji,jj,jk) 
    151159                     sn(ji,jj,jk) = sa(ji,jj,jk) 
    … …  
    165173                  END DO 
    166174               END DO 
     175               IF( l_trdtra ) THEN 
     176                  ztrdt(:,:,jk) = 0.e0 
     177                  ztrds(:,:,jk) = 0.e0 
     178               END IF 
    167179            ELSE 
     180               IF( l_trdtra ) THEN 
     181                  DO jj = 1, jpj 
     182                     DO ji = 1, jpi 
     183                        ztrdt(ji,jj,jk) = atfp * ( tb(ji,jj,jk) - 2*tn(ji,jj,jk) + ta(ji,jj,jk) ) 
     184                        ztrds(ji,jj,jk) = atfp * ( sb(ji,jj,jk) - 2*sn(ji,jj,jk) + sa(ji,jj,jk) ) 
     185                     END DO 
     186                  END DO 
     187               END IF 
    168188               DO jj = 1, jpj 
    169189                  DO ji = 1, jpi 
    … …  
    180200      !                                                ! =============== 
    181201 
    182       IF(ln_ctl) THEN         ! print mean field (used for debugging) 
    183          CALL prt_ctl(tab3d_1=tn, clinfo1=' nxt  - Tn: ', mask1=tmask, & 
    184             &         tab3d_2=sn, clinfo2=' Sn: ', mask2=tmask) 
    185       ENDIF 
    186        
     202      IF( l_trdtra )   THEN      ! Take the Asselin trend into account  
     203         ztrdt(:,:,:) = ztrdt(:,:,:) / ( 2.*rdt ) 
     204         ztrds(:,:,:) = ztrds(:,:,:) / ( 2.*rdt )          
     205         CALL trd_mod( ztrdt, ztrds, jptra_trd_atf, 'TRA', kt ) 
     206      END IF 
     207 
     208      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tn, clinfo1=' nxt  - Tn: ', mask1=tmask,   & 
     209         &                       tab3d_2=sn, clinfo2=       ' Sn: ', mask2=tmask ) 
    187210#if defined key_agrif 
    188211      IF (.NOT.Agrif_Root())    CALL Agrif_Update_Tra( kt ) 
    189212#endif       
    190  
     213      ! 
    191214   END SUBROUTINE tra_nxt 
    192215 

  • trunk/NEMO/OPA_SRC/TRA/traqsr.F90

    r474 r503  
    44   !! Ocean physics: solar radiation penetration in the top ocean levels 
    55   !!====================================================================== 
    6    !! History : 
    7    !!   6.0  !  90-10  (B. Blanke)  Original code 
    8    !!   7.0  !  91-11  (G. Madec) 
    9    !!        !  96-01  (G. Madec)  s-coordinates 
    10    !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    11    !!   9.0  !  04-08  (C. Talandier) New trends organization 
    12    !!   9.0  !  05-11  (G. Madec) zco, zps, sco coordinate 
     6   !! History :  6.0  !  90-10  (B. Blanke)  Original code 
     7   !!            7.0  !  91-11  (G. Madec) 
     8   !!                 !  96-01  (G. Madec)  s-coordinates 
     9   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     10   !!            9.0  !  05-11  (G. Madec) zco, zps, sco coordinate 
     11   !!---------------------------------------------------------------------- 
     12 
    1313   !!---------------------------------------------------------------------- 
    1414   !!   tra_qsr      : trend due to the solar radiation penetration 
    1515   !!   tra_qsr_init : solar radiation penetration initialization 
    1616   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1817   USE oce             ! ocean dynamics and active tracers 
    1918   USE dom_oce         ! ocean space and time domain 
    … …  
    2928   PRIVATE 
    3029 
    31    !! * Routine accessibility 
    32    PUBLIC tra_qsr      ! routine called by step.F90 (ln_traqsr=T) 
    33    PUBLIC tra_qsr_init ! routine called by opa.F90 
    34  
    35    !! * Shared module variables 
    36    LOGICAL, PUBLIC ::   ln_traqsr = .TRUE.   !: qsr flag (Default=T) 
    37  
    38    !! * Module variables 
    39    REAL(wp), PUBLIC ::  & !!! * penetrative solar radiation namelist * 
    40       rabs = 0.58_wp,   &  ! fraction associated with xsi1 
    41       xsi1 = 0.35_wp,   &  ! first depth of extinction  
    42       xsi2 = 23.0_wp       ! second depth of extinction  
    43       !                    ! (default values: water type Ib) 
    44    LOGICAL ::           &  
    45       ln_qsr_sms = .false. ! flag to use or not the biological  
    46       !                    ! fluxes for light  
     30   PUBLIC   tra_qsr      ! routine called by step.F90 (ln_traqsr=T) 
     31   PUBLIC   tra_qsr_init ! routine called by opa.F90 
     32 
     33   !!* Namelist namqsr: penetrative solar radiation 
     34   LOGICAL , PUBLIC ::   ln_traqsr = .TRUE.   !: qsr flag (Default=T) 
     35   REAL(wp), PUBLIC ::   rabs = 0.58_wp       ! fraction associated with xsi1 
     36   REAL(wp), PUBLIC ::   xsi1 = 0.35_wp       ! first depth of extinction  
     37   REAL(wp), PUBLIC ::   xsi2 = 23.0_wp       ! second depth of extinction (default values: water type Ib) 
     38   LOGICAL , PUBLIC ::   ln_qsr_sms = .false. ! flag to use or not the biological fluxes for light  
     39   NAMELIST/namqsr/ ln_traqsr, rabs, xsi1, xsi2, ln_qsr_sms 
    4740    
    48    INTEGER ::    & 
    49       nksr                 ! number of levels 
    50    REAL(wp), DIMENSION(jpk) ::   & 
    51       gdsr                 ! profile of the solar flux penetration 
     41   INTEGER ::   nksr   ! number of levels 
     42   REAL(wp), DIMENSION(jpk) ::   gdsr   ! profile of the solar flux penetration 
    5243 
    5344   !! * Substitutions 
    … …  
    5748   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    5849   !! $Header$  
    59    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     50   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6051   !!---------------------------------------------------------------------- 
    6152 
    … …  
    8677      !! ** Action  : - update ta with the penetrative solar radiation trend 
    8778      !!              - save the trend in ttrd ('key_trdtra') 
    88       !! 
    89       !!---------------------------------------------------------------------- 
    90       !! * Modules used      
    91       USE oce, ONLY :    ztrdt => ua,   & ! use ua as 3D workspace    
    92                          ztrds => va      ! use va as 3D workspace    
    93  
    94       !! * Arguments 
    95       INTEGER, INTENT( in ) ::   kt       ! ocean time-step 
    96  
    97       !! * Local declarations 
    98       INTEGER ::    ji, jj, jk            ! dummy loop indexes 
    99       REAL(wp) ::   zc0 , zta             ! temporary scalars 
     79      !!---------------------------------------------------------------------- 
     80      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
     81      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
     82      !! 
     83      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
     84      !! 
     85      INTEGER  ::    ji, jj, jk       ! dummy loop indexes 
     86      REAL(wp) ::   zc0 , zta         ! temporary scalars 
    10087      !!---------------------------------------------------------------------- 
    10188 
    10289      IF( kt == nit000 ) THEN 
    103          IF ( lwp ) WRITE(numout,*) 
    104          IF ( lwp ) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation' 
    105          IF ( lwp ) WRITE(numout,*) '~~~~~~~' 
     90         IF(lwp) WRITE(numout,*) 
     91         IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation' 
     92         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    10693         CALL tra_qsr_init 
    10794      ENDIF 
    10895 
    109       ! Save ta and sa trends 
    110       IF( l_trdtra )   THEN 
     96      IF( l_trdtra ) THEN      ! Save ta and sa trends 
    11197         ztrdt(:,:,:) = ta(:,:,:)  
    11298         ztrds(:,:,:) = 0.e0 
    … …  
    122108            DO jj = 2, jpjm1 
    123109               DO ji = fs_2, fs_jpim1   ! vector opt. 
    124                    
    125110                  zc0 = ro0cpr  / fse3t(ji,jj,jk)         ! compute the qsr trend 
    126111                  zta = zc0 * ( etot3(ji,jj,jk  ) * tmask(ji,jj,jk)     & 
    127112                     &        - etot3(ji,jj,jk+1) * tmask(ji,jj,jk+1) ) 
    128                    
    129113                  ta(ji,jj,jk) = ta(ji,jj,jk) + zta       ! add qsr trend to the temperature trend 
    130                    
    131114               END DO 
    132115            END DO 
    … …  
    179162      ENDIF 
    180163 
    181       ! qsr tracers trends saved the trends for diagnostics 
    182       IF( l_trdtra )   THEN 
     164      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    183165         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    184          CALL trd_mod( ztrdt, ztrds, jpttdqsr, 'TRA', kt ) 
    185       ENDIF 
    186  
     166         CALL trd_mod( ztrdt, ztrds, jptra_trd_qsr, 'TRA', kt ) 
     167      ENDIF 
    187168      !                       ! print mean trends (used for debugging) 
    188169      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    189  
     170      ! 
    190171   END SUBROUTINE tra_qsr 
    191172 
    … …  
    206187      !! ** Action  : - initialize xsr1, xsr2 and rabs 
    207188      !! 
    208       !! Reference : 
    209       !!   Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
    210       !!---------------------------------------------------------------------- 
    211       INTEGER ::    ji,jj,jk, &  ! dummy loop index 
    212                     indic        ! temporary integer 
    213       REAL(wp) ::   zc0 , zc1 , zc2 ,   & ! temporary scalars 
    214          &          zcst, zdp1, zdp2      !    "         " 
    215  
    216       NAMELIST/namqsr/ ln_traqsr, rabs, xsi1, xsi2, ln_qsr_sms 
    217       !!---------------------------------------------------------------------- 
    218  
    219       ! Read Namelist namqsr : ratio and length of penetration 
    220       ! -------------------- 
    221       REWIND ( numnam ) 
     189      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
     190      !!---------------------------------------------------------------------- 
     191      INTEGER  ::   ji, jj, jk   ! dummy loop index 
     192      INTEGER  ::   indic        ! temporary integer 
     193      REAL(wp) ::   zc0 , zc1 , zc2    ! temporary scalars 
     194      REAL(wp) ::   zcst, zdp1, zdp2   !    "         " 
     195      !!---------------------------------------------------------------------- 
     196 
     197      REWIND ( numnam )           ! Read Namelist namqsr : ratio and length of penetration 
    222198      READ   ( numnam, namqsr ) 
    223199 
    224       ! Parameter control and print 
    225       ! --------------------------- 
    226       IF( ln_traqsr  ) THEN 
     200      IF( ln_traqsr  ) THEN       ! Parameter control and print 
    227201         IF(lwp) THEN 
    228202            WRITE(numout,*) 
    … …  
    248222         CALL ctl_stop( '             0<rabs<1, 0<xsi1, or 0<xsi2 not satisfied' ) 
    249223 
    250       ! Initialization of gdsr 
    251       ! ---------------------- 
     224      !                           ! Initialization of gdsr 
    252225      IF( ln_zco .OR. ln_zps ) THEN 
    253  
     226         ! 
    254227         ! z-coordinate with or without partial step : same w-level everywhere inside the ocean 
    255228         gdsr(:) = 0.e0 
    … …  
    283256            END DO 
    284257         ENDIF 
    285  
     258         ! 
    286259      ENDIF 
    287260 
    … …  
    302275            END DO 
    303276         END DO  
    304        ENDIF 
    305  
     277      ENDIF 
     278      ! 
    306279   END SUBROUTINE tra_qsr_init 
    307280 

  • trunk/NEMO/OPA_SRC/TRA/trasbc.F90

    r457 r503  
    44   !! Ocean active tracers:  surface boundary condition 
    55   !!============================================================================== 
    6    !! History : 
    7    !!   8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
    8    !!   8.2  !  01-02  (D. Ludicone)  sea ice and free surface 
    9    !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    10    !!   9.0  !  04-08  (C. Talandier) New trends organization 
     6   !! History :  8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
     7   !!            8.2  !  01-02  (D. Ludicone)  sea ice and free surface 
     8   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     9   !!---------------------------------------------------------------------- 
     10 
    1111   !!---------------------------------------------------------------------- 
    1212   !!   tra_sbc      : update the tracer trend at ocean surface 
    1313   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1514   USE oce             ! ocean dynamics and active tracers 
    1615   USE dom_oce         ! ocean space domain variables 
    … …  
    2625   PRIVATE 
    2726 
    28    !! * Routine accessibility 
    29    PUBLIC tra_sbc              ! routine called by step.F90 
     27   PUBLIC   tra_sbc    ! routine called by step.F90 
    3028 
    3129   !! * Substitutions 
    … …  
    3533   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    3634   !! $Header$  
    37    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     35   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3836   !!---------------------------------------------------------------------- 
    3937 
    … …  
    7876      !!                with the tracer surface boundary condition  
    7977      !!              - save the trend it in ttrd ('key_trdtra') 
     78      !!---------------------------------------------------------------------- 
     79      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
     80      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
    8081      !! 
    81       !!---------------------------------------------------------------------- 
    82       !! * Modules used      
    83       USE oce, ONLY :    ztdta => ua,      & ! use ua as 3D workspace    
    84                          ztdsa => va         ! use va as 3D workspace    
    85  
    86       !! * Arguments 
    87       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    88  
    89       !! * Local declarations 
     82      INTEGER, INTENT(in) ::   kt     ! ocean time-step index 
     83      !! 
    9084      INTEGER  ::   ji, jj                   ! dummy loop indices 
    9185      REAL(wp) ::   zta, zsa, zsrau, zse3t   ! temporary scalars 
    … …  
    9892      ENDIF 
    9993 
    100       ! 0. initialization 
    101       zsrau = 1. / rauw 
     94      zsrau = 1. / rauw             ! initialization 
    10295#if defined key_zco 
    10396      zse3t = 1. / e3t_0(1) 
    10497#endif 
    10598 
    106       ! Save ta and sa trends 
    107       IF( l_trdtra )   THEN 
    108          ztdta(:,:,:) = ta(:,:,:)  
    109          ztdsa(:,:,:) = sa(:,:,:)  
     99      IF( l_trdtra ) THEN           ! Save ta and sa trends 
     100         ztrdt(:,:,:) = ta(:,:,:)  
     101         ztrds(:,:,:) = sa(:,:,:)  
    110102      ENDIF 
    111103 
    112104      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration 
    113105 
    114       ! 1. Concentration dillution effect on (t,s) 
     106      ! Concentration dillution effect on (t,s) 
    115107      DO jj = 2, jpj 
    116108         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    118110            zse3t = 1. / fse3t(ji,jj,1) 
    119111#endif 
    120             ! temperature : heat flux 
    121             zta = ro0cpr * ( qt(ji,jj) - qsr(ji,jj) ) * zse3t 
    122  
    123             ! salinity :  concent./dilut. effect 
    124             zsa = emps(ji,jj) * zsrau * sn(ji,jj,1) * zse3t 
    125              
    126             ! add the trend to the general tracer trend 
    127             ta(ji,jj,1) = ta(ji,jj,1) + zta 
     112            zta = ro0cpr * ( qt(ji,jj) - qsr(ji,jj) ) * zse3t      ! temperature : heat flux 
     113            zsa = emps(ji,jj) * zsrau * sn(ji,jj,1)   * zse3t      ! salinity :  concent./dilut. effect 
     114            ta(ji,jj,1) = ta(ji,jj,1) + zta                        ! add the trend to the general tracer trend 
    128115            sa(ji,jj,1) = sa(ji,jj,1) + zsa 
    129116         END DO 
    130117      END DO 
    131118 
    132       ! save the trends for diagnostic 
    133       ! sea surface boundary condition tracers trends 
    134       IF( l_trdtra )   THEN 
    135          ztdta(:,:,:) = ta(:,:,:) - ztdta(:,:,:) 
    136          ztdsa(:,:,:) = sa(:,:,:) - ztdsa(:,:,:) 
    137          CALL trd_mod(ztdta, ztdsa, jpttdnsr, 'TRA', kt) 
     119      IF( l_trdtra ) THEN      ! save the sbc trends for diagnostic 
     120         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
     121         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
     122         CALL trd_mod(ztrdt, ztrds, jptra_trd_nsr, 'TRA', kt) 
    138123      ENDIF 
    139        
    140       IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    141          CALL prt_ctl(tab3d_1=ta, clinfo1=' sbc  - Ta: ', mask1=tmask, & 
    142             &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    143       ENDIF 
    144  
     124      ! 
     125      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' sbc  - Ta: ', mask1=tmask,   & 
     126         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     127      ! 
    145128   END SUBROUTINE tra_sbc 
    146129 

  • trunk/NEMO/OPA_SRC/TRA/trazdf.F90

    r458 r503  
    44   !! Ocean active tracers:  vertical component of the tracer mixing trend 
    55   !!============================================================================== 
    6    !! History : 
    7    !!   9.0  !  05-11  (G. Madec)  Original code 
     6   !! History :  9.0  !  05-11  (G. Madec)  Original code 
     7   !!---------------------------------------------------------------------- 
     8 
    89   !!---------------------------------------------------------------------- 
    910   !!   tra_zdf      : Update the tracer trend with the vertical diffusion 
    1011   !!       zdf_ctl  : ??? 
    1112   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1313   USE oce             ! ocean dynamics and tracers variables 
    1414   USE dom_oce         ! ocean space and time domain variables  
    … …  
    2828   PRIVATE 
    2929 
    30    !! * Routine accessibility 
    3130   PUBLIC tra_zdf   !  routine called by step.F90 
    3231 
    33    !! * module variables 
    34    INTEGER ::                        & 
    35       nzdf = 0                         ! type vertical diffusion algorithm used 
     32   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    3633      !                                ! defined from ln_zdf...  namlist logicals) 
    3734 
    38    !! * Module variables 
    39    REAL(wp), DIMENSION(jpk) ::  & 
    40       r2dt                          ! vertical profile time-step, = 2 rdttra 
    41       !                             ! except at nit000 (=rdttra) if neuler=0 
     35   REAL(wp), DIMENSION(jpk) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
     36      !                                ! except at nit000 (=rdttra) if neuler=0 
    4237 
    4338   !! * Substitutions 
    … …  
    4742   !!---------------------------------------------------------------------- 
    4843   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     44   !! $Header$  
     45   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4946   !!---------------------------------------------------------------------- 
    5047 
    … …  
    5653      !! 
    5754      !! ** Purpose :   compute the vertical ocean tracer physics. 
    58       !! ** Method  : 
    59       !! ** Action  : 
    60       !! 
    6155      !!--------------------------------------------------------------------- 
    62       !! * Arguments 
    6356      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    6457 
    65       !! * local declarations 
    6658      INTEGER  ::   jk                   ! Dummy loop indices 
    67       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    68          ztrdt, ztrds                         ! 3D temporary workspace 
     59      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt, ztrds   ! 3D workspace 
    6960      !!--------------------------------------------------------------------- 
    7061 
    … …  
    7768         r2dt(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog) 
    7869      ENDIF 
    79  
    8070 
    8171      IF( l_trdtra )   THEN                      ! temporary save of ta and sa trends 
    … …  
    10191            ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    10292            ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    103             CALL trd_mod( ztrdt, ztrds, jpttdzdf, 'TRA', kt ) 
     93            CALL trd_mod( ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt ) 
    10494         ENDIF 
    10595 
    … …  
    111101               ztrds(:,:,jk) = ( ( sa(:,:,jk) - sb(:,:,jk) ) / r2dt(jk) ) - ztrds(:,:,jk) 
    112102            END DO 
    113             CALL trd_mod( ztrdt, ztrds, jpttdzdf, 'TRA', kt ) 
     103            CALL trd_mod( ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt ) 
    114104         ENDIF 
    115105 
    … …  
    121111               ztrds(:,:,jk) = ( ( sa(:,:,jk) - sb(:,:,jk) ) / r2dt(jk) ) - ztrds(:,:,jk) 
    122112            END DO 
    123             CALL trd_mod( ztrdt, ztrds, jpttdzdf, 'TRA', kt ) 
     113            CALL trd_mod( ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt ) 
    124114         ENDIF 
    125115 
    … …  
    146136      !!      NB: rotation of lateral mixing operator or TKE or KPP scheme, 
    147137      !!      the implicit scheme is required. 
    148       !! 
    149138      !!---------------------------------------------------------------------- 
    150       !! * Module used 
    151139      USE zdftke 
    152140      USE zdfkpp 

  • trunk/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r457 r503  
    1313   !!        !  00-08 (G. Madec) double diffusive mixing 
    1414   !!   8.5  !  02-08 (G. Madec)  F90: Free form and module 
    15    !!   9.0  !  04-08 (C. Talandier) New trends organization 
    16    !!   " "  !  06-11 (G. Madec)  New step reorganisation 
     15   !!   9.0  !  06-11 (G. Madec)  New step reorganisation 
    1716   !!---------------------------------------------------------------------- 
    1817   !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical   
    … …  
    6160      !! 
    6261      !! ** Method  :   The vertical component of the lateral diffusive trends 
    63       !!      is provided by a 2nd order operator rotated along neural or geo- 
     62      !!      is provided by a 2nd order operator rotated along neutral or geo- 
    6463      !!      potential surfaces to which an eddy induced advection can be  
    6564      !!      added. It is computed using before fields (forward in time) and  

  • trunk/NEMO/OPA_SRC/TRD/trdicp.F90

    r249 r503  
    44   !! Ocean diagnostics:  ocean tracers and dynamic trends 
    55   !!===================================================================== 
     6   !! History :       !  91-12 (G. Madec) 
     7   !!                 !  92-06 (M. Imbard) add time step frequency 
     8   !!                 !  96-01 (G. Madec)  terrain following coordinates 
     9   !!            8.5  !  02-06 (G. Madec)  F90: Free form and module 
     10   !!            9.0  !  04-08 (C. Talandier) New trends organization 
     11   !!---------------------------------------------------------------------- 
    612#if  defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa 
    713   !!---------------------------------------------------------------------- 
    … …  
    915   !!   'key_trddyn'                            momentum trends diagnostics 
    1016   !!---------------------------------------------------------------------- 
    11  
    12    !!---------------------------------------------------------------------- 
    13    !!   trd              : verify the basin averaged properties for tra/dyn  
     17   !!---------------------------------------------------------------------- 
     18   !!   trd_icp          : compute the basin averaged properties for tra/dyn  
    1419   !!   trd_dwr          : print dynmaic trends in ocean.output file 
    1520   !!   trd_twr          : print tracers trends in ocean.output file 
    1621   !!   trd_icp_init     : initialization step 
    1722   !!---------------------------------------------------------------------- 
    18    !! * Modules used 
    1923   USE oce             ! ocean dynamics and tracers variables 
    2024   USE dom_oce         ! ocean space and time domain variables 
    … …  
    3135   PRIVATE 
    3236 
    33    !! * Interfaces 
    34    INTERFACE trd 
     37   INTERFACE trd_icp 
    3538      MODULE PROCEDURE trd_2d, trd_3d 
    3639   END INTERFACE 
    3740 
    38    !! * Routine accessibility 
    39    PUBLIC trd                   ! called by step.F90 
    40    PUBLIC trd_dwr               ! called by step.F90 
    41    PUBLIC trd_twr               ! called by step.F90 
    42    PUBLIC trd_icp_init          ! called by opa.F90 
    43  
    44    !! * Shared module variables 
    45 #if  defined key_trdtra   &&   defined key_trddyn    ||   defined key_esopa 
    46    LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag 
    47    LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag 
    48 #elif  defined key_trdtra 
    49    LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag 
    50    LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag 
    51 #elif  defined key_trddyn 
    52    LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag 
    53    LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag 
    54 #endif 
     41   PUBLIC   trd_icp       ! called by trdmod.F90 
     42   PUBLIC   trd_dwr       ! called by step.F90 
     43   PUBLIC   trd_twr       ! called by step.F90 
     44   PUBLIC   trd_icp_init  ! called by opa.F90 
    5545 
    5646   !! * Substitutions 
    … …  
    6050   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    6151   !! $Header$  
    62    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     52   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6353   !!---------------------------------------------------------------------- 
    6454 
    6555CONTAINS 
    6656 
    67    SUBROUTINE trd_2d(ptrd2dx, ptrd2dy, ktrd , ctype) 
     57   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype, clpas ) 
    6858      !!--------------------------------------------------------------------- 
    6959      !!                  ***  ROUTINE trd_2d  *** 
    … …  
    7161      !! ** Purpose : verify the basin averaged properties of tracers and/or 
    7262      !!              momentum equations at every time step frequency ntrd. 
     63      !!---------------------------------------------------------------------- 
     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 
     68      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   clpas     ! number of passage 
    7369      !! 
    74       !! ** Method : 
    75       !! 
    76       !! History : 
    77       !!        !  91-12 (G. Madec) 
    78       !!        !  92-06 (M. Imbard) add time step frequency 
    79       !!        !  96-01 (G. Madec)  terrain following coordinates 
    80       !!   8.5  !  02-06 (G. Madec)  F90: Free form and module 
    81       !!   9.0  !  04-08 (C. Talandier) New trends organization 
    82       !!---------------------------------------------------------------------- 
    83       !! * Arguments 
    84       REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   & 
    85          ptrd2dx,                      &   ! Temperature or U trend  
    86          ptrd2dy                           ! Salinity    or V trend 
    87  
    88       INTEGER, INTENT( in ) ::   ktrd      ! tracer trend index 
    89  
    90       CHARACTER(len=3), INTENT( in ) ::   & 
    91          ctype                             ! momentum or tracers trends type 
    92          !                                 ! 'DYN' or 'TRA' 
    93  
    94       !! * Local declarations 
    95       INTEGER ::   ji, jj        ! loop indices 
    96       REAL(wp) ::   & 
    97          zbt, zbtu, zbtv,     &  ! temporary scalars 
    98          zmsku, zmskv            !    "         " 
    99       !!---------------------------------------------------------------------- 
    100  
    101       ! 1. Advective trends and forcing trend 
    102       ! ------------------------------------- 
    103  
    104       ! 1.1 Mask the forcing trend and substract it from the vertical diffusion trend 
    105       SELECT CASE (ctype) 
    106  
    107       CASE ('DYN')              ! Momentum 
     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' 
     78      IF( PRESENT(clpas) )  cpas = clpas 
     79 
     80      ! 1. Mask trends 
     81      ! -------------- 
     82 
     83      SELECT CASE( ctype ) 
     84      ! 
     85      CASE( 'DYN' )              ! Momentum 
    10886         DO jj = 1, jpjm1 
    10987            DO ji = 1, jpim1 
    … …  
    11694         ptrd2dx(jpi, : ) = 0.e0      ;      ptrd2dy(jpi, : ) = 0.e0 
    11795         ptrd2dx( : ,jpj) = 0.e0      ;      ptrd2dy( : ,jpj) = 0.e0 
    118  
    119       CASE ('TRA')              ! Tracers 
     96         ! 
     97      CASE( 'TRA' )              ! Tracers 
    12098         ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:) 
    12199         ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:) 
    122  
     100         ! 
    123101      END SELECT 
    124102       
    125       ! 2. Basin averaged tracer trend 
    126       ! ------------------------------ 
    127  
    128       SELECT CASE (ctype) 
    129  
    130       CASE ('DYN')              ! Momentum 
     103      ! 2. Basin averaged tracer/momentum trends 
     104      ! ---------------------------------------- 
     105 
     106      SELECT CASE( ctype ) 
     107      ! 
     108      CASE( 'DYN' )              ! Momentum 
    131109         umo(ktrd) = 0.e0 
    132110         vmo(ktrd) = 0.e0 
    133  
    134          SELECT CASE (ktrd) 
    135  
    136          CASE (jpdtdswf)         ! surface forcing 
     111         ! 
     112         SELECT CASE( ktrd ) 
     113         ! 
     114         CASE( jpdyn_trd_swf )         ! surface forcing 
    137115            DO jj = 1, jpj 
    138116               DO ji = 1, jpi 
    … …  
    141119               END DO 
    142120            END DO 
    143  
    144          CASE (jpdtdbfr)         ! bottom friction fluxes 
     121            ! 
     122         CASE( jpdyn_trd_bfr )         ! bottom friction fluxes 
    145123            DO jj = 1, jpj 
    146124               DO ji = 1, jpi 
    … …  
    149127               END DO 
    150128            END DO 
    151  
     129            ! 
    152130         END SELECT 
    153  
    154       CASE ('TRA')              ! Tracers 
    155          tmo(ktrd) = 0.e0 
    156          smo(ktrd) = 0.e0 
     131         ! 
     132      CASE( 'TRA' )              ! Tracers 
     133         IF( cpas == 'fst' )   THEN 
     134            tmo(ktrd) = 0.e0 
     135            smo(ktrd) = 0.e0 
     136         ENDIF 
    157137         DO jj = 1, jpj 
    158138            DO ji = 1, jpi 
    … …  
    162142            END DO 
    163143         END DO 
    164  
     144         ! 
    165145      END SELECT 
    166146       
    167       ! 3. Basin averaged tracer square trend 
    168       ! ------------------------------------- 
     147      ! 3. Basin averaged tracer/momentum square trends 
     148      ! ---------------------------------------------- 
    169149      ! c a u t i o n: field now 
    170150       
    171       SELECT CASE (ctype) 
    172  
    173       CASE ('DYN')              ! Momentum 
     151      SELECT CASE( ctype ) 
     152      ! 
     153      CASE( 'DYN' )              ! Momentum 
    174154         hke(ktrd) = 0.e0 
    175155         DO jj = 1, jpj 
    … …  
    182162            END DO 
    183163         END DO 
    184  
    185       CASE ('TRA')              ! Tracers 
    186          t2(ktrd) = 0.e0 
    187          s2(ktrd) = 0.e0 
     164         ! 
     165      CASE( 'TRA' )              ! Tracers 
     166         IF( cpas == 'fst' )   THEN 
     167            t2(ktrd) = 0.e0 
     168            s2(ktrd) = 0.e0 
     169         ENDIF 
    188170         DO jj = 1, jpj 
    189171            DO ji = 1, jpi 
    … …  
    193175            END DO 
    194176         END DO 
    195        
     177         !       
    196178      END SELECT 
    197  
     179      ! 
    198180   END SUBROUTINE trd_2d 
    199181 
    200182 
    201  
    202    SUBROUTINE trd_3d(ptrd3dx, ptrd3dy, ktrd, ctype) 
     183   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd, ctype, clpas ) 
    203184      !!--------------------------------------------------------------------- 
    204185      !!                  ***  ROUTINE trd_3d  *** 
    … …  
    206187      !! ** Purpose : verify the basin averaged properties of tracers and/or 
    207188      !!              momentum equations at every time step frequency ntrd. 
     189      !!---------------------------------------------------------------------- 
     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 
    208195      !! 
    209       !! ** Method : 
    210       !! 
    211       !! History : 
    212       !!        !  91-12 (G. Madec) 
    213       !!        !  92-06 (M. Imbard) add time step frequency 
    214       !!        !  96-01 (G. Madec)  terrain following coordinates 
    215       !!   8.5  !  02-06 (G. Madec)  F90: Free form and module 
    216       !!   9.0  !  04-08 (C. Talandier) New trends organization 
    217       !!---------------------------------------------------------------------- 
    218       !! * Arguments 
    219       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
    220           ptrd3dx,                     &   ! Temperature or U trend  
    221           ptrd3dy                          ! Salinity    or V trend 
    222  
    223       INTEGER, INTENT( in ) ::   ktrd      ! momentum or tracer trend index 
    224  
    225       CHARACTER(len=3), INTENT( in ) ::   & 
    226          ctype                             ! momentum or tracers trends type 
    227          !                                 ! 'DYN' or 'TRA' 
    228  
    229       !! * Local declarations 
    230196      INTEGER ::   ji, jj, jk 
    231       REAL(wp) ::   & 
    232          zbt, zbtu, zbtv,               &  ! temporary scalars 
    233          zmsku, zmskv 
    234       !!---------------------------------------------------------------------- 
    235  
    236       ! 1. Advective trends and forcing trend 
    237       ! ------------------------------------- 
    238  
    239       ! Mask the trends 
    240       SELECT CASE (ctype) 
    241  
    242       CASE ('DYN')              ! Momentum         
     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' 
     203      IF( PRESENT(clpas) )  cpas = clpas 
     204 
     205      ! 1. Mask the trends 
     206      ! ------------------ 
     207 
     208      SELECT CASE( ctype ) 
     209      ! 
     210      CASE( 'DYN' )              ! Momentum         
    243211         DO jk = 1, jpk 
    244212            DO jj = 1, jpjm1 
    … …  
    248216                  ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * zmsku 
    249217                  ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * zmskv 
    250                ENDDO 
    251             ENDDO 
    252          ENDDO 
    253  
     218               END DO 
     219            END DO 
     220         END DO 
    254221         ptrd3dx(jpi, : ,:) = 0.e0      ;      ptrd3dy(jpi, : ,:) = 0.e0 
    255222         ptrd3dx( : ,jpj,:) = 0.e0      ;      ptrd3dy( : ,jpj,:) = 0.e0 
    256  
    257       CASE ('TRA')              ! Tracers 
     223         ! 
     224      CASE( 'TRA' )              ! Tracers 
    258225         DO jk = 1, jpk 
    259226            ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    260227            ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    261          ENDDO 
    262  
     228         END DO 
     229         ! 
    263230      END SELECT    
    264231 
    265       ! 2. Basin averaged tracer/momentum trend 
    266       ! --------------------------------------- 
     232      ! 2. Basin averaged tracer/momentum trends 
     233      ! ---------------------------------------- 
    267234       
    268       SELECT CASE (ctype) 
    269  
    270       CASE ('DYN')              ! Momentum 
     235      SELECT CASE( ctype ) 
     236      ! 
     237      CASE( 'DYN' )              ! Momentum 
    271238         umo(ktrd) = 0.e0 
    272239         vmo(ktrd) = 0.e0 
    … …  
    281248            END DO 
    282249         END DO 
    283  
    284       CASE ('TRA')              ! Tracers 
    285          tmo(ktrd) = 0.e0 
    286          smo(ktrd) = 0.e0 
     250         ! 
     251      CASE( 'TRA' )              ! Tracers 
     252         IF( cpas == 'fst' )   THEN 
     253            tmo(ktrd) = 0.e0 
     254            smo(ktrd) = 0.e0 
     255         ENDIF 
    287256         DO jk = 1, jpkm1 
    288257            DO jj = 1, jpj 
    … …  
    294263            END DO 
    295264         END DO 
    296  
     265         ! 
    297266      END SELECT 
    298267 
    299       ! 3. Basin averaged tracer/momentum square trend 
    300       ! ---------------------------------------------- 
     268      ! 3. Basin averaged tracer/momentum square trends 
     269      ! ----------------------------------------------- 
    301270      ! c a u t i o n: field now 
    302271       
    303       SELECT CASE (ctype) 
    304  
    305       CASE ('DYN')              ! Momentum 
     272      SELECT CASE( ctype ) 
     273      ! 
     274      CASE( 'DYN' )              ! Momentum 
    306275         hke(ktrd) = 0.e0 
    307276         DO jk = 1, jpk 
    … …  
    316285            END DO 
    317286         END DO 
    318  
    319       CASE ('TRA')              ! Tracers 
    320          t2(ktrd) = 0.e0 
    321          s2(ktrd) = 0.e0 
     287         ! 
     288      CASE( 'TRA' )              ! Tracers 
     289         IF( cpas == 'fst' )   THEN 
     290            t2(ktrd) = 0.e0 
     291            s2(ktrd) = 0.e0 
     292         ENDIF 
    322293         DO jk = 1, jpk 
    323294            DO jj = 1, jpj 
    … …  
    329300            END DO 
    330301         END DO 
    331  
     302         ! 
    332303      END SELECT 
    333  
     304      ! 
    334305   END SUBROUTINE trd_3d 
    335306 
    … …  
    340311      !!                  ***  ROUTINE trd_icp_init  *** 
    341312      !!  
    342       !! ** Purpose :    
    343       !! 
    344       !! ** Method  : 
    345       !! 
    346       !! History : 
    347       !!   9.0  !  03-09 (G. Madec)  Original code 
    348       !!        !  04-08 (C. Talandier) New trends organization 
    349       !!---------------------------------------------------------------------- 
    350       !! * Local declarations 
    351       INTEGER :: ji, jj, jk 
    352  
     313      !! ** Purpose :   Read the namtrd namelist 
     314      !!---------------------------------------------------------------------- 
     315      INTEGER  ::   ji, jj, jk 
    353316      REAL(wp) ::   zmskt 
    354317#if  defined key_trddyn 
    355       REAL(wp) ::   zmsku,zmskv 
     318      REAL(wp) ::   zmsku, zmskv 
    356319#endif 
    357  
    358       NAMELIST/namtrd/ ntrd, nctls 
    359       !!---------------------------------------------------------------------- 
    360  
    361       ! namelist namtrd : trend diagnostic 
    362       REWIND( numnam ) 
    363       READ  ( numnam, namtrd ) 
     320      !!---------------------------------------------------------------------- 
    364321 
    365322      IF(lwp) THEN 
    … …  
    367324         WRITE(numout,*) 'trd_icp_init : integral constraints properties trends' 
    368325         WRITE(numout,*) '~~~~~~~~~~~~~' 
    369          WRITE(numout,*) ' ' 
    370          WRITE(numout,*) '          Namelist namtrd : ' 
    371          WRITE(numout,*) '             time step frequency trend       ntrd  = ', ntrd 
    372326      ENDIF 
    373  
    374       ! initialisation of BBL tracers lateral diffusion to zero 
    375       tldfbbl(:,:) = 0.e0   ;   sldfbbl(:,:) = 0.e0   
    376       ! initialisation of BBL tracers lateral advection to zero 
    377       tladbbl(:,:) = 0.e0   ;   sladbbl(:,:) = 0.e0   
    378       ! initialisation of workspace 
    379       tladi(:,:,:) = 0.e0  ;  tladj(:,:,:) = 0.e0 
    380       sladi(:,:,:) = 0.e0  ;  sladj(:,:,:) = 0.e0 
    381327 
    382328      ! Total volume at t-points: 
    … …  
    392338      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain 
    393339 
    394       IF(lwp) THEN 
    395          WRITE(numout,*) 
    396          WRITE(numout,*) '          total ocean volume at T-point   tvolt = ',tvolt 
    397       ENDIF 
     340      IF(lwp) WRITE(numout,*) '                total ocean volume at T-point   tvolt = ',tvolt 
    398341 
    399342#if  defined key_trddyn 
    … …  
    419362 
    420363      IF(lwp) THEN 
    421          WRITE(numout,*) '          total ocean volume at U-point   tvolu = ',tvolu 
    422          WRITE(numout,*) '          total ocean volume at V-point   tvolv = ',tvolv 
    423          WRITE(numout,*) ' ' 
     364         WRITE(numout,*) '                total ocean volume at U-point   tvolu = ',tvolu 
     365         WRITE(numout,*) '                total ocean volume at V-point   tvolv = ',tvolv 
    424366      ENDIF 
    425367#endif 
    426  
     368      ! 
    427369   END SUBROUTINE trd_icp_init 
    428  
    429370 
    430371 
    … …  
    434375      !!  
    435376      !! ** Purpose :  write dynamic trends in ocean.output  
     377      !!---------------------------------------------------------------------- 
     378      INTEGER, INTENT(in) ::   kt                                  ! ocean time-step index 
    436379      !! 
    437       !! ** Method  : 
    438       !! 
    439       !! History : 
    440       !!   9.0  !  03-09  (G. Madec)  Original code 
    441       !!        !  04-08  (C. Talandier)  New trends organization 
    442       !!---------------------------------------------------------------------- 
    443       !! * Arguments 
    444       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    445       INTEGER ::   ji, jj, jk 
    446       REAL(wp) ::   & 
    447          ze1e2w,zcof,        &  !    "         " 
    448          zbe1ru, zbe2rv,     &  !    "         " 
    449          zbtr, ztz, zth  
    450  
    451       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    452                zkepe, zkx, zky, zkz              ! temporary arrays 
     380      INTEGER  ::   ji, jj, jk 
     381      REAL(wp) ::   ze1e2w, zcof, zbe1ru, zbe2rv, zbtr, ztz, zth   !    "      scalars 
     382      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zkepe, zkx, zky, zkz   ! temporary arrays 
    453383      !!---------------------------------------------------------------------- 
    454384 
    … …  
    462392         ! c a u t i o n here, trends are computed at kt+1 (now , but after the swap) 
    463393 
    464          zkx(:,:,:) = 0.e0 
    465          zky(:,:,:) = 0.e0 
    466          zkz(:,:,:) = 0.e0 
     394         zkx(:,:,:)   = 0.e0 
     395         zky(:,:,:)   = 0.e0 
     396         zkz(:,:,:)   = 0.e0 
    467397         zkepe(:,:,:) = 0.e0 
    468398    
    469399         CALL eos( tn, sn, rhd, rhop )       ! now potential and in situ densities 
    470400 
    471          ! 4.1 Density flux at w-point 
     401         ! Density flux at w-point 
    472402         DO jk = 2, jpk 
    473403            DO jj = 1, jpj 
    … …  
    478408            END DO 
    479409         END DO 
    480          zkz  (:,:, 1 ) = 0.e0 
     410         zkz(:,:,1) = 0.e0 
    481411          
    482412         ! Density flux at u and v-points 
    … …  
    524454         ! --------------------------------- 
    525455         IF( lk_mpp ) THEN 
    526                CALL mpp_sum( peke ) 
    527                CALL mpp_sum( umo , 11 ) 
    528                CALL mpp_sum( vmo , 11 ) 
    529                CALL mpp_sum( hke , 10 ) 
    530          END IF 
     456            CALL mpp_sum( peke ) 
     457            CALL mpp_sum( umo , jptot_dyn ) 
     458            CALL mpp_sum( vmo , jptot_dyn ) 
     459            CALL mpp_sum( hke , jptot_dyn ) 
     460         ENDIF 
    531461 
    532462         ! I.2 Print dynamic trends in the ocean.output file 
    … …  
    537467            WRITE (numout,*) 
    538468            WRITE (numout,9500) kt 
    539             WRITE (numout,9501) umo( 1) / tvolu, vmo( 1) / tvolv 
    540             WRITE (numout,9502) umo( 2) / tvolu, vmo( 2) / tvolv 
    541             WRITE (numout,9503) umo( 3) / tvolu, vmo( 3) / tvolv 
    542             WRITE (numout,9504) umo( 4) / tvolu, vmo( 4) / tvolv 
    543             WRITE (numout,9505) umo( 5) / tvolu, vmo( 5) / tvolv 
    544             WRITE (numout,9506) umo( 6) / tvolu, vmo( 6) / tvolv 
    545             WRITE (numout,9507) umo( 7) / tvolu, vmo( 7) / tvolv 
    546             WRITE (numout,9508) umo( 8) / tvolu, vmo( 8) / tvolv 
    547             WRITE (numout,9509) umo(10) / tvolu, vmo(10) / tvolv 
    548             WRITE (numout,9510) umo( 9) / tvolu, vmo( 9) / tvolv 
    549             WRITE (numout,9511) umo(11) / tvolu, vmo(11) / tvolv 
     469            WRITE (numout,9501) umo(jpicpd_hpg) / tvolu, vmo(jpicpd_hpg) / tvolv 
     470            WRITE (numout,9502) umo(jpicpd_keg) / tvolu, vmo(jpicpd_keg) / tvolv 
     471            WRITE (numout,9503) umo(jpicpd_rvo) / tvolu, vmo(jpicpd_rvo) / tvolv 
     472            WRITE (numout,9504) umo(jpicpd_pvo) / tvolu, vmo(jpicpd_pvo) / tvolv 
     473            WRITE (numout,9505) umo(jpicpd_ldf) / tvolu, vmo(jpicpd_ldf) / tvolv 
     474            WRITE (numout,9506) umo(jpicpd_zad) / tvolu, vmo(jpicpd_zad) / tvolv 
     475            WRITE (numout,9507) umo(jpicpd_zdf) / tvolu, vmo(jpicpd_zdf) / tvolv 
     476            WRITE (numout,9508) umo(jpicpd_spg) / tvolu, vmo(jpicpd_spg) / tvolv 
     477            WRITE (numout,9509) umo(jpicpd_swf) / tvolu, vmo(jpicpd_swf) / tvolv 
     478            WRITE (numout,9510) umo(jpicpd_dat) / tvolu, vmo(jpicpd_dat) / tvolv 
     479            WRITE (numout,9511) umo(jpicpd_bfr) / tvolu, vmo(jpicpd_bfr) / tvolv 
    550480            WRITE (numout,9512) 
    551481            WRITE (numout,9513)                                                 & 
    552             &     (  umo(1) + umo(2) + umo(3) + umo( 4) + umo( 5) + umo(6)    & 
    553             &      + umo(7) + umo(8) + umo(9) + umo(10) + umo(11) ) / tvolu,   & 
    554             &     (  vmo(1) + vmo(2) + vmo(3) + vmo( 4) + vmo( 5) + vmo(6)    & 
    555             &      + vmo(7) + vmo(8) + vmo(9) + vmo(10) + vmo(11) ) / tvolv 
     482            &     (  umo(jpicpd_hpg) + umo(jpicpd_keg) + umo(jpicpd_rvo) + umo(jpicpd_pvo) + umo(jpicpd_ldf)   & 
     483            &      + umo(jpicpd_zad) + umo(jpicpd_zdf) + umo(jpicpd_spg) + umo(jpicpd_dat) + umo(jpicpd_swf)   & 
     484            &      + umo(jpicpd_bfr) ) / tvolu,   & 
     485            &     (  vmo(jpicpd_hpg) + vmo(jpicpd_keg) + vmo(jpicpd_rvo) + vmo(jpicpd_pvo) + vmo(jpicpd_ldf)   & 
     486            &      + vmo(jpicpd_zad) + vmo(jpicpd_zdf) + vmo(jpicpd_spg) + vmo(jpicpd_dat) + vmo(jpicpd_swf)   & 
     487            &      + vmo(jpicpd_bfr) ) / tvolv 
    556488         ENDIF 
    557489 
    … …  
    565497 9507    FORMAT(' vertical diffusion         u= ', e20.13, '    v= ', e20.13) 
    566498 9508    FORMAT(' surface pressure gradient  u= ', e20.13, '    v= ', e20.13) 
    567  9509    FORMAT(' forcing term               u= ', e20.13, '    v= ', e20.13) 
     499 9509    FORMAT(' surface wind forcing       u= ', e20.13, '    v= ', e20.13) 
    568500 9510    FORMAT(' dampimg term               u= ', e20.13, '    v= ', e20.13) 
    569501 9511    FORMAT(' bottom flux                u= ', e20.13, '    v= ', e20.13) 
    … …  
    575507            WRITE (numout,*) 
    576508            WRITE (numout,9520) kt 
    577             WRITE (numout,9521) hke( 1) / tvolt 
    578             WRITE (numout,9522) hke( 2) / tvolt 
    579             WRITE (numout,9523) hke( 3) / tvolt 
    580             WRITE (numout,9524) hke( 4) / tvolt 
    581             WRITE (numout,9525) hke( 5) / tvolt 
    582             WRITE (numout,9526) hke( 6) / tvolt 
    583             WRITE (numout,9527) hke( 7) / tvolt 
    584             WRITE (numout,9528) hke( 8) / tvolt 
    585             WRITE (numout,9529) hke(10) / tvolt 
    586             WRITE (numout,9530) hke( 9) / tvolt 
     509            WRITE (numout,9521) hke(jpicpd_hpg) / tvolt 
     510            WRITE (numout,9522) hke(jpicpd_keg) / tvolt 
     511            WRITE (numout,9523) hke(jpicpd_rvo) / tvolt 
     512            WRITE (numout,9524) hke(jpicpd_pvo) / tvolt 
     513            WRITE (numout,9525) hke(jpicpd_ldf) / tvolt 
     514            WRITE (numout,9526) hke(jpicpd_zad) / tvolt 
     515            WRITE (numout,9527) hke(jpicpd_zdf) / tvolt 
     516            WRITE (numout,9528) hke(jpicpd_spg) / tvolt 
     517            WRITE (numout,9529) hke(jpicpd_swf) / tvolt 
     518            WRITE (numout,9530) hke(jpicpd_dat) / tvolt 
    587519            WRITE (numout,9531) 
    588520            WRITE (numout,9532)   & 
    589             &     (  hke(1) + hke(2) + hke(3) + hke(4) + hke(5) + hke(6)   & 
    590             &      + hke(7) + hke(8) + hke(9) + hke(10) ) / tvolt 
     521            &     (  hke(jpicpd_hpg) + hke(jpicpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_pvo) + hke(jpicpd_ldf)   & 
     522            &      + hke(jpicpd_zad) + hke(jpicpd_zdf) + hke(jpicpd_spg) + hke(jpicpd_dat) + hke(jpicpd_swf) ) / tvolt 
    591523         ENDIF 
    592524 
    … …  
    600532 9527    FORMAT(' vertical diffusion        u2= ', e20.13) 
    601533 9528    FORMAT(' surface pressure gradient u2= ', e20.13) 
    602  9529    FORMAT(' forcing term              u2= ', e20.13) 
     534 9529    FORMAT(' surface wind forcing      u2= ', e20.13) 
    603535 9530    FORMAT(' dampimg term              u2= ', e20.13) 
    604536 9531    FORMAT(' --------------------------------------------------') 
    … …  
    609541            WRITE (numout,*) 
    610542            WRITE (numout,9540) kt 
    611             WRITE (numout,9541) ( hke(2) + hke(3) + hke(6) ) / tvolt 
    612             WRITE (numout,9542) ( hke(2) + hke(6) ) / tvolt 
    613             WRITE (numout,9543) ( hke(4) ) / tvolt 
    614             WRITE (numout,9544) ( hke(3) ) / tvolt 
    615             WRITE (numout,9545) ( hke(8) ) / tvolt 
    616             WRITE (numout,9546) ( hke(5) ) / tvolt 
    617             WRITE (numout,9547) ( hke(7) ) / tvolt 
    618             WRITE (numout,9548) ( hke(1) ) / tvolt, rpktrd / tvolt 
     543            WRITE (numout,9541) ( hke(jpicpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_zad) ) / tvolt 
     544            WRITE (numout,9542) ( hke(jpicpd_keg) + hke(jpicpd_zad) ) / tvolt 
     545            WRITE (numout,9543) ( hke(jpicpd_pvo) ) / tvolt 
     546            WRITE (numout,9544) ( hke(jpicpd_rvo) ) / tvolt 
     547            WRITE (numout,9545) ( hke(jpicpd_spg) ) / tvolt 
     548            WRITE (numout,9546) ( hke(jpicpd_ldf) ) / tvolt 
     549            WRITE (numout,9547) ( hke(jpicpd_zdf) ) / tvolt 
     550            WRITE (numout,9548) ( hke(jpicpd_hpg) ) / tvolt, rpktrd / tvolt 
     551            WRITE (numout,*) 
     552            WRITE (numout,*) 
    619553         ENDIF 
    620554 
    621555 9540    FORMAT(' energetic consistency at it= ', i6, ' :', /' =========================================') 
    622556 9541    FORMAT(' 0 = non linear term(true if key_vorenergy or key_combined): ', e20.13) 
    623  9542    FORMAT(' 0 = ke gradient + vertical advection              : ', e20.13) 
     557 9542    FORMAT(' 0 = ke gradient + vertical advection                      : ', e20.13) 
    624558 9543    FORMAT(' 0 = coriolis term  (true if key_vorenergy or key_combined): ', e20.13) 
    625  9544    FORMAT(' 0 = uh.( rot(u) x uh ) (true if enstrophy conser.)    : ', e20.13) 
    626  9545    FORMAT(' 0 = surface pressure gradient                     : ', e20.13) 
    627  9546    FORMAT(' 0 > horizontal diffusion                          : ', e20.13) 
    628  9547    FORMAT(' 0 > vertical diffusion                            : ', e20.13) 
    629  9548    FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop)        : ', e20.13, '  u.dz(rhop) =', e20.13) 
    630  
     559 9544    FORMAT(' 0 = uh.( rot(u) x uh ) (true if enstrophy conser.)        : ', e20.13) 
     560 9545    FORMAT(' 0 = surface pressure gradient                             : ', e20.13) 
     561 9546    FORMAT(' 0 > horizontal diffusion                                  : ', e20.13) 
     562 9547    FORMAT(' 0 > vertical diffusion                                    : ', e20.13) 
     563 9548    FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop)                : ', e20.13, '  u.dz(rhop) =', e20.13) 
     564         ! 
    631565         ! Save potential to kinetic energy conversion for next time step 
    632566         rpktrd = peke 
    633  
     567         ! 
    634568      ENDIF 
    635  
     569      ! 
    636570   END SUBROUTINE trd_dwr 
    637  
    638  
    639571 
    640572 
    … …  
    644576      !!  
    645577      !! ** Purpose :  write active tracers trends in ocean.output  
    646       !! 
    647       !! ** Method  : 
    648       !! 
    649       !! History : 
    650       !!   9.0  !  03-09  (G. Madec)  Original code 
    651       !!        !  04-08  (C. Talandier)  New trends organization 
    652       !!---------------------------------------------------------------------- 
    653       !! * Arguments 
    654       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    655  
     578      !!---------------------------------------------------------------------- 
     579      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    656580      !!---------------------------------------------------------------------- 
    657581 
    … …  
    664588         ! ------------------------------- 
    665589         IF( lk_mpp ) THEN 
    666             CALL mpp_sum( tmo, 10 )    
    667             CALL mpp_sum( smo, 10 ) 
    668             CALL mpp_sum( t2 , 10 ) 
    669             CALL mpp_sum( s2 , 10 ) 
     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 ) 
    670594         ENDIF 
    671595 
    … …  
    677601            WRITE (numout,*) 
    678602            WRITE (numout,9400) kt 
    679             WRITE (numout,9401) tmo(1) / tvolt, smo(1) / tvolt 
    680             WRITE (numout,9402) tmo(2) / tvolt, smo(2) / tvolt 
    681             WRITE (numout,9403) tmo(3) / tvolt, smo(3) / tvolt 
    682             WRITE (numout,9404) tmo(4) / tvolt, smo(4) / tvolt 
    683             WRITE (numout,9405) tmo(5) / tvolt, smo(5) / tvolt 
    684             WRITE (numout,9406) tmo(6) / tvolt, smo(6) / tvolt 
    685             WRITE (numout,9407) tmo(7) / tvolt 
    686             WRITE (numout,9408) tmo(8) / tvolt, smo(8) / tvolt 
    687             WRITE (numout,9409) 
    688             WRITE (numout,9410) (  tmo(1) + tmo(2) + tmo(3) + tmo(4)              & 
    689             &                    + tmo(5) + tmo(6) + tmo(7) + tmo(8) ) / tvolt,   & 
    690             &                   (  smo(1) + smo(2) + smo(3) + smo(4)              & 
    691             &                    + smo(5) + smo(6)           + smo(8) ) / tvolt 
     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 
     611            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 
    692616         ENDIF 
    693617 
    … …  
    6986229403     FORMAT(' horizontal diffusion        ',e20.13,'     ',e20.13) 
    6996239404     FORMAT(' vertical diffusion          ',e20.13,'     ',e20.13) 
    700 9405     FORMAT(' STATIC instability mixing   ',e20.13,'     ',e20.13) 
     6249405     FORMAT(' static instability mixing   ',e20.13,'     ',e20.13) 
    7016259406     FORMAT(' damping term                ',e20.13,'     ',e20.13) 
    702 9407     FORMAT(' penetrative qsr             ',e20.13,'     ',e20.13) 
    703 9408     FORMAT(' forcing term                ',e20.13,'     ',e20.13) 
     6269407     FORMAT(' penetrative qsr             ',e20.13) 
     6279408     FORMAT(' non solar radiation         ',e20.13,'     ',e20.13) 
    7046289409     FORMAT(' -------------------------------------------------------------------------') 
    7056299410     FORMAT(' total trend                 ',e20.13,'     ',e20.13) 
    … …  
    710634            WRITE (numout,*) 
    711635            WRITE (numout,9420) kt 
    712             WRITE (numout,9421) t2(1) / tvolt, s2(1) / tvolt 
    713             WRITE (numout,9422) t2(2) / tvolt, s2(2) / tvolt 
    714             WRITE (numout,9423) t2(3) / tvolt, s2(3) / tvolt 
    715             WRITE (numout,9424) t2(4) / tvolt, s2(4) / tvolt 
    716             WRITE (numout,9425) t2(5) / tvolt, s2(5) / tvolt 
    717             WRITE (numout,9426) t2(6) / tvolt, s2(6) / tvolt 
    718             WRITE (numout,9427) t2(7) / tvolt 
    719             WRITE (numout,9428) t2(8) / tvolt, s2(8) / tvolt 
     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 
    720644            WRITE (numout,9429) 
    721             WRITE (numout,9430) (  t2(1) + t2(2) + t2(3) + t2(4)              & 
    722             &                    + t2(5) + t2(6) + t2(7) + t2(8) ) / tvolt,   & 
    723             &                   (  s2(1) + s2(2) + s2(3) + s2(4)              & 
    724             &                    + s2(5) + s2(6)          + s2(8) ) / tvolt 
     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 
    725649         ENDIF 
    726650 
    … …  
    7316559423     FORMAT(' horizontal diffusion      * t   ', e20.13, '     ', e20.13) 
    7326569424     FORMAT(' vertical diffusion        * t   ', e20.13, '     ', e20.13) 
    733 9425     FORMAT(' STATIC instability mixing * t   ', e20.13, '     ', e20.13) 
     6579425     FORMAT(' static instability mixing * t   ', e20.13, '     ', e20.13) 
    7346589426     FORMAT(' damping term              * t   ', e20.13, '     ', e20.13) 
    735 9427     FORMAT(' penetrative qsr           * t   ', e20.13, '     ', e20.13) 
    736 9428     FORMAT(' forcing term              * t   ', e20.13, '     ', e20.13) 
     6599427     FORMAT(' penetrative qsr           * t   ', e20.13) 
     6609428     FORMAT(' non solar radiation       * t   ', e20.13, '     ', e20.13) 
    7376619429     FORMAT(' -----------------------------------------------------------------------------') 
    7386629430     FORMAT(' total trend                *t = ', e20.13, '  *s = ', e20.13) 
    … …  
    743667            WRITE (numout,*) 
    744668            WRITE (numout,9440) kt 
    745             WRITE (numout,9441) ( tmo(1)+tmo(2) )/tvolt, ( smo(1)+smo(2) )/tvolt 
    746             WRITE (numout,9442)   tmo(3)/tvolt,  smo(3)/tvolt 
    747             WRITE (numout,9443)   tmo(4)/tvolt,  smo(4)/tvolt 
    748             WRITE (numout,9444)   tmo(5)/tvolt,  smo(5)/tvolt 
    749             WRITE (numout,9445) ( t2(1)+t2(2) )/tvolt, ( s2(1)+s2(2) )/tvolt 
    750             WRITE (numout,9446)   t2(3)/tvolt,   s2(3)/tvolt 
    751             WRITE (numout,9447)   t2(4)/tvolt,   s2(4)/tvolt 
    752             WRITE (numout,9448)   t2(5)/tvolt,   s2(5)/tvolt 
     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 
    753680         ENDIF 
    754681 
    … …  
    756683            ' :         temperature','                salinity',/,   & 
    757684            ' ==================================') 
    758 9441     FORMAT(' 0 = horizontal+vertical advection      ',e20.13,'       ',e20.13) 
    759 9442     FORMAT(' 0 = horizontal diffusion               ',e20.13,'       ',e20.13) 
    760 9443     FORMAT(' 0 = vertical diffusion                 ',e20.13,'       ',e20.13) 
    761 9444     FORMAT(' 0 = static instability mixing          ',e20.13,'       ',e20.13) 
    762 9445     FORMAT(' 0 = horizontal+vertical advection * t  ',e20.13,'       ',e20.13) 
    763 9446     FORMAT(' 0 > horizontal diffusion          * t  ',e20.13,'       ',e20.13) 
    764 9447     FORMAT(' 0 > vertical diffusion            * t  ',e20.13,'       ',e20.13) 
    765 9448     FORMAT(' 0 > static instability mixing     * t  ',e20.13,'       ',e20.13) 
    766  
     6859441     FORMAT(' 0 = horizontal+vertical advection +    ',e20.13,'       ',e20.13) 
     6869442     FORMAT('     1st lev vertical advection         ',e20.13,'       ',e20.13) 
     6879443     FORMAT(' 0 = horizontal diffusion               ',e20.13,'       ',e20.13) 
     6889444     FORMAT(' 0 = vertical diffusion                 ',e20.13,'       ',e20.13) 
     6899445     FORMAT(' 0 = static instability mixing          ',e20.13,'       ',e20.13) 
     6909446     FORMAT(' 0 = horizontal+vertical advection * t  ',e20.13,'       ',e20.13) 
     6919447     FORMAT(' 0 > horizontal diffusion          * t  ',e20.13,'       ',e20.13) 
     6929448     FORMAT(' 0 > vertical diffusion            * t  ',e20.13,'       ',e20.13) 
     6939449     FORMAT(' 0 > static instability mixing     * t  ',e20.13,'       ',e20.13) 
     694         ! 
    767695      ENDIF 
    768  
     696      ! 
    769697   END SUBROUTINE trd_twr 
    770698 
    … …  
    773701   !!   Default case :                                         Empty module 
    774702   !!---------------------------------------------------------------------- 
    775    LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag 
    776    LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag 
    777703CONTAINS 
    778    SUBROUTINE trd_2d(ptrd2dx, ptrd2dy, ktrd , ctype)       ! Empty routine 
    779       REAL, DIMENSION(:,:,:), INTENT( inout ) ::   & 
    780           ptrd2dx,                     &   ! Temperature or U trend  
    781           ptrd2dy                          ! Salinity    or V trend 
    782       INTEGER, INTENT( in ) ::   ktrd      ! momentum or tracer trend index 
    783       CHARACTER(len=3), INTENT( in ) ::   & 
    784          ctype                             ! momentum or tracers trends type 
    785       WRITE(*,*) 'trd_2d: You should not have seen this print! error ?', ptrd2dx(1,1,1) 
    786       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptrd2dy(1,1,1) 
    787       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd 
    788       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype 
     704   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype )       ! Empty routine 
     705      REAL, DIMENSION(:,:) ::   ptrd2dx, ptrd2dy 
     706      WRITE(*,*) 'trd_2d: You should not have seen this print! error ?', ptrd2dx(1,1), ptrd2dy(1,1), ktrd, ctype 
    789707   END SUBROUTINE trd_2d 
    790    SUBROUTINE trd_3d(ptrd3dx, ptrd3dy, ktrd , ctype)       ! Empty routine 
    791       REAL, DIMENSION(:,:,:), INTENT( inout ) ::   & 
    792           ptrd3dx,                     &   ! Temperature or U trend  
    793           ptrd3dy                          ! Salinity    or V trend 
    794       INTEGER, INTENT( in ) ::   ktrd      ! momentum or tracer trend index 
    795       CHARACTER(len=3), INTENT( in ) ::   & 
    796          ctype                             ! momentum or tracers trends type 
    797       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1) 
    798       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptrd3dy(1,1,1) 
    799       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd 
    800       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype 
     708   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd , ctype )       ! Empty routine 
     709      REAL, DIMENSION(:,:,:) ::   ptrd3dx, ptrd3dy 
     710      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1), ktrd, ctype 
    801711   END SUBROUTINE trd_3d 
    802712   SUBROUTINE trd_icp_init               ! Empty routine 
    803713   END SUBROUTINE trd_icp_init 
    804714   SUBROUTINE trd_dwr( kt )          ! Empty routine 
    805       INTEGER, INTENT(in) :: kt 
    806715      WRITE(*,*) 'trd_dwr: You should not have seen this print! error ?', kt 
    807716   END SUBROUTINE trd_dwr 
    808717   SUBROUTINE trd_twr( kt )          ! Empty routine 
    809       INTEGER, INTENT(in) :: kt 
    810718      WRITE(*,*) 'trd_twr: You should not have seen this print! error ?', kt 
    811719   END SUBROUTINE trd_twr 

  • trunk/NEMO/OPA_SRC/TRD/trdicp_oce.F90

    r247 r503  
    66 
    77   !!---------------------------------------------------------------------- 
    8    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    9    !! $Header$  
    10    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    11    !!---------------------------------------------------------------------- 
    12    !!---------------------------------------------------------------------- 
    138   !!   'key_trdtra'   or                         tracer trends diagnostics 
    149   !!   'key_trddyn'                            momentum trends diagnostics 
    1510   !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    1711   USE par_oce                 ! ocean parameters 
    1812 
    … …  
    2014   PUBLIC 
    2115 
    22    !! Namelist parameters 
    23    !!---------------------------------------------------------------------- 
    24    INTEGER  ::      & !!: namdia :  diagnostics on dynamics and/or tracer trends 
    25       ntrd  = 10 ,  &  !: time step frequency dynamics and tracers trends 
    26       nctls =  0       !: control surface type for trends vertical integration 
     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 
    2730 
    2831   !! Tracers trends diagnostics parameters 
    2932   !!--------------------------------------------------------------------- 
    30    INTEGER, PARAMETER ::            &  !: trends index 
    31       jpttdlad = 1,   &  !: tracer horizontal advection 
    32       jpttdzad = 2,   &  !: tracer vertical advection 
    33       jpttdldf = 3,   &  !: tracer horizontal diffusion 
    34       jpttdzdf = 4,   &  !: tracer vertical diffusion 
    35       jpttdnpc = 5,   &  !: tracer non penetrative convection 
    36       jpttddoe = 6,   &  !: tracer D.amping O.r vertical E.iv 
    37       jpttdqsr = 7,   &  !: tracer penetrative solar radiation 
    38       jpttdnsr = 8       !: tracer non solar radiation 
     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 
    3946 
     47   INTEGER, PARAMETER ::   &  !: => Total tracer trends indexes <= 
     48        jptot_tra = 12        !: change it when adding/removing one indice above 
     49    
    4050   !! Momentum trends diagnostics parameters 
    4151   !!--------------------------------------------------------------------- 
    42    INTEGER, PARAMETER ::            &  !: trends index 
    43       jpdtdhpg =  1,   &  !: dynamic hydrostatic pressure gradient  
    44       jpdtdkeg =  2,   &  !: dynamic kinetic energy gradient 
    45       jpdtdrvo =  3,   &  !: dynamic relative vorticity 
    46       jpdtdpvo =  4,   &  !: dynamic planetary vorticity 
    47       jpdtdldf =  5,   &  !: dynamic lateral diffusion 
    48       jpdtdzad =  6,   &  !: dynamic vertical advection 
    49       jpdtdzdf =  7,   &  !: dynamic vertical diffusion 
    50       jpdtdspg =  8,   &  !: dynamic surface pressure gradient 
    51       jpdtddat =  9,   &  !: dynamic damping term 
    52       jpdtdswf = 10,   &  !: dynamic surface wind forcing 
    53       jpdtdbfr = 11       !: dynamic bottom friction  
     52   INTEGER, PARAMETER ::   &  !: => dynamic trends indexes <= 
     53        jpicpd_hpg =  1,   &  !: hydrostatic pressure gradient  
     54        jpicpd_keg =  2,   &  !: kinetic energy gradient 
     55        jpicpd_rvo =  3,   &  !: relative vorticity 
     56        jpicpd_pvo =  4,   &  !: planetary vorticity 
     57        jpicpd_ldf =  5,   &  !: lateral diffusion 
     58        jpicpd_zad =  6,   &  !: vertical advection 
     59        jpicpd_zdf =  7,   &  !: vertical diffusion 
     60        jpicpd_spg =  8,   &  !: surface pressure gradient 
     61        jpicpd_dat =  9,   &  !: damping term 
     62        jpicpd_swf = 10,   &  !: surface wind forcing 
     63        jpicpd_bfr = 11       !: bottom friction  
    5464 
    55    REAL, DIMENSION(jpi,jpj) ::   &  !: 
    56       tldfbbl, sldfbbl,          &  ! Temperature/salinity lateral diffusion trends 
    57       !                             ! in the BBL   
    58       tladbbl, sladbbl              ! Temperature/salinity lateral advection trends  
    59       !                             ! in the BBL 
    60  
    61    REAL, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    62       tladi, sladi,                  &  ! Temp./sal. MUSCL OR TVD advection fluxes  
    63       !                                 ! terms along i-  
    64       tladj, sladj                      ! Temp./sal. MUSCL OR TVD advection fluxes  
    65       !                                 ! terms along j-  
    66 #if defined key_ldfslp 
    67    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &  !: 
    68       uldftrd, vldftrd     !: lateral diffusion trend in isopycnal case 
    69 #endif 
     65   INTEGER, PARAMETER ::   &  !: => Total dynamic trends indexes <= 
     66        jptot_dyn = 11        !: change it when adding/removing one indice above 
     67    
    7068#if   defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa 
    7169 
    7270   !! Variables used for diagnostics 
    7371   !!--------------------------------------------------------------------- 
    74    REAL(wp) ::   &  !: 
    75       tvolt,     &  !: volume of the whole ocean computed at t-points 
    76       tvolu,     &  !: volume of the whole ocean computed at u-points 
    77       tvolv         !: volume of the whole ocean computed at v-points 
     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 
    7875 
    7976   !! Tracers trends diagnostics variables 
    8077   !!--------------------------------------------------------------------- 
    81    REAL(wp), DIMENSION(10) ::   &  !: 
    82       tmo, smo         !: tracers trends average  
    83       !                !  tmo(1) : horizontal advection 
    84       !                !  tmo(2) : vertical advection 
    85       !                !  tmo(3) : horizontal diffusion 
    86       !                !  tmo(4) : vertical diffusion 
    87       !                !  tmo(5) : static instability 
    88       !                !  tmo(6) : damping OR vertical EIV 
    89       !                !  tmo(7) : penetrative solar radiation (T only) 
    90    REAL(wp), DIMENSION(10) ::   &  !: 
    91       t2, s2           !: tracers square trends average  
    92       !                !  t2(1) : horizontal advection 
    93       !                !  t2(2) : vertical advection 
    94       !                !  t2(3) : horizontal diffusion 
    95       !                !  t2(4) : vertical diffusion 
    96       !                !  t2(5) : static instability 
    97       !                !  t2(6) : damping OR vertical EIV 
    98       !                !  t2(7) : penetrative solar radiation (T only) 
     78   REAL(wp), DIMENSION(jptot_tra) ::   tmo, smo         !: tracers trends average  
     79   REAL(wp), DIMENSION(jptot_tra) ::   t2, s2           !: tracers square trends average  
    9980    
    10081   !! Momentum trends diagnostics variables 
    10182   !!--------------------------------------------------------------------- 
    102    REAL(wp), DIMENSION(11) ::   &  !: 
    103       umo, vmo         !: momentum trends average  
    104       !                !  umo(1) : hydrostatic pressure gradient 
    105       !                !  umo(2) : kinetic energy 
    106       !                !  umo(3) : lateral diffusion geo-pot 
    107       !                !  umo(4) :  
    108       !                !  umo(5) : lateral diffusion 
    109       !                !  umo(6) : vertical advection 
    110       !                !  umo(7) : vertical diffusion 
    111       !                !  umo(8) : surface pressure gradient 
    112       !                !  umo(9) :  
    113  
    114    REAL(wp), DIMENSION(10) ::   &  !: 
    115       hke              !: momentum square trends average  
    116       !                !  hke(1) : horizontal advection 
    117       !                !  hke(2) : vertical advection 
    118  
    119    REAL(wp) ::   &  !: 
    120       rpktrd,    &  !: potential to kinetic energy conversion 
    121       peke          !: conversion potential energy - kinetic energy trend 
     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 
    12287 
    12388#endif 
    124  
    125   !!====================================================================== 
     89   !!---------------------------------------------------------------------- 
     90   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     91   !! $Header$  
     92   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     93   !!====================================================================== 
    12694END MODULE trdicp_oce 

  • trunk/NEMO/OPA_SRC/TRD/trdmld.F90

    r352 r503  
    44   !! Ocean diagnostics:  mixed layer T-S trends  
    55   !!===================================================================== 
     6   !! History :       !  95-04  (J. Vialard)    Original code 
     7   !!                 !  97-02  (E. Guilyardi)  Adaptation global + base cmo 
     8   !!                 !  99-09  (E. Guilyardi)  Re-writing + netCDF output 
     9   !!            8.5  !  02-06  (G. Madec)      F90: Free form and module 
     10   !!            9.0  !  04-08  (C. Talandier)  New trends organization 
     11   !!                 !  05-05  (C. Deltel)     Diagnose trends of time averaged ML T & S 
     12   !!---------------------------------------------------------------------- 
    613#if   defined key_trdmld   ||   defined key_esopa 
    714   !!---------------------------------------------------------------------- 
    815   !!   'key_trdmld'                          mixed layer trend diagnostics 
     16   !!---------------------------------------------------------------------- 
    917   !!---------------------------------------------------------------------- 
    1018   !!   trd_mld          : T and S cumulated trends averaged over the mixed layer 
    … …  
    1220   !!   trd_mld_init     : initialization step 
    1321   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1522   USE oce             ! ocean dynamics and tracers variables 
    1623   USE dom_oce         ! ocean space and time domain variables 
    … …  
    2835   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2936   USE diadimg         ! dimg direct access file format output 
     37   USE trdmld_rst , ONLY : trd_mld_rst_read  ! restart for diagnosing the ML trends 
     38   USE prtctl          ! Print control 
    3039 
    3140   IMPLICIT NONE 
    3241   PRIVATE 
    3342 
    34    !! * Accessibility 
    35    PUBLIC trd_mld        ! routine called by step.F90 
    36    PUBLIC trd_mld_init   ! routine called by opa.F90 
    37    PUBLIC trd_mld_zint   ! routine called by tracers routines 
    38  
    39    !! * Shared module variables 
    40    LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .TRUE.    !: momentum trend flag 
    41  
    42    !! * Module variables 
    43    INTEGER ::   & 
    44       nh_t, nmoymltrd,             &  ! ??? 
    45       nidtrd,                      & 
    46       ndextrd1(jpi*jpj),           & 
    47       ndimtrd1 
    48    INTEGER, SAVE ::   & 
    49       ionce, icount,               & 
    50       idebug                          ! (0/1) set it to 1 in case of problem to have more print 
    51  
    52    INTEGER, DIMENSION(jpi,jpj) ::   & 
    53       nmld,                         & ! mixed layer depth 
    54       nbol                 
    55  
    56    REAL(wp), DIMENSION(jpi,jpj) ::   & 
    57       rmld   ,          &  ! mld depth (m) corresponding to nmld 
    58       tml    , sml  ,   &  ! average T and S over mixed layer 
    59       tmlb   , smlb ,   &  ! before tml and sml (kt-1) 
    60       tmlbb  , smlbb,   &  ! tml and sml at begining of the nwrite-1  
    61       !                    ! timestep averaging period 
    62       tmlbn  , smlbn,   &  ! after tml and sml at time step after the 
    63       !                    ! begining of the NWRITE-1 timesteps 
    64       tmltrdm, smltrdm     ! 
    65  
    66    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    67       tmltrd ,          &  ! total cumulative trends of temperature and  
    68       smltrd ,          &  ! salinity over nwrite-1 time steps 
    69       wkx 
    70  
    71    CHARACTER(LEN=80) :: clname 
     43   PUBLIC   trd_mld        ! routine called by step.F90 
     44   PUBLIC   trd_mld_init   ! routine called by opa.F90 
     45   PUBLIC   trd_mld_zint   ! routine called by tracers routines 
     46 
     47   CHARACTER (LEN=40) ::  clhstnam         ! name of the trends NetCDF file 
     48   INTEGER ::   nh_t, nmoymltrd 
     49   INTEGER ::   nidtrd, ndextrd1(jpi*jpj) 
     50   INTEGER ::   ndimtrd1                         
     51   INTEGER, SAVE ::  ionce, icount                    
    7252 
    7353   !! * Substitutions 
    … …  
    8363CONTAINS 
    8464 
    85 SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype ) 
     65   SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype ) 
    8666      !!---------------------------------------------------------------------- 
    8767      !!                  ***  ROUTINE trd_mld_zint  *** 
    8868      !!  
    89       !! ** Purpose :   computation of vertically integrated T and S budgets 
    90       !!                from ocean surface down to control surface  
     69      !! ** Purpose :   Compute the vertical average of the 3D fields given as arguments  
     70      !!                to the subroutine. This vertical average is performed from ocean 
     71      !!                surface down to a chosen control surface. 
    9172      !! 
    9273      !! ** Method/usage : 
    93       !!      integration done over nwrite-1 time steps  
    94       !!      Control surface can be either a mixed layer depth (time varying) 
     74      !!      The control surface can be either a mixed layer depth (time varying) 
    9575      !!      or a fixed surface (jk level or bowl).  
    96       !!      Choose control surface with nctls in namelist NAMDIA. 
    97       !!      nctls = 0  : use mixed layer with density criterion  
    98       !!      nctls = 1  : read index from file 'ctlsurf_idx' 
    99       !!      nctls > 1  : use fixed level surface jk = nctls 
     76      !!      Choose control surface with nctls in namelist NAMTRD : 
     77      !!        nctls = 0  : use mixed layer with density criterion  
     78      !!        nctls = 1  : read index from file 'ctlsurf_idx' 
     79      !!        nctls > 1  : use fixed level surface jk = nctls 
    10080      !!      Note: in the remainder of the routine, the volume between the  
    10181      !!            surface and the control surface is called "mixed-layer" 
    102       !!      Method check : if the control surface is fixed, the residual dh/dt 
    103       !!                     entrainment should be zero 
    104       !! 
    105       !! ** Action : 
    106       !!            /commld/   : rmld         mld depth corresponding to nmld 
    107       !!                         tml          average T over mixed layer 
    108       !!                         tmlb         tml at kt-1 
    109       !!                         tmlbb        tml at begining of the NWRITE-1  
    110       !!                                      time steps averaging period 
    111       !!                         tmlbn        tml at time step after the  
    112       !!                                      begining of the NWRITE-1 time 
    113       !!                                      steps averaging period 
    114       !! 
    115       !!                  mixed layer trends : 
    116       !! 
    117       !!                  tmltrd (,,1) = zonal advection 
    118       !!                  tmltrd (,,2) = meridional advection 
    119       !!                  tmltrd (,,3) = vertical advection 
    120       !!                  tmltrd (,,4) = lateral diffusion (horiz. component+Beckman) 
    121       !!                  tmltrd (,,5) = forcing 
    122       !!                  tmltrd (,,6) = entrainment due to vertical diffusion (TKE) 
    123       !!          if iso  tmltrd (,,7) = lateral diffusion (vertical component) 
    124       !!                  tmltrd (,,8) = eddy induced zonal advection 
    125       !!                  tmltrd (,,9) = eddy induced meridional advection 
    126       !!                  tmltrd (,,10) = eddy induced vertical advection 
    127       !! 
    128       !!                  tmltrdm(,) : total cumulative trends over nwrite-1 time steps 
    129       !!                  ztmltot(,) : dT/dt over the NWRITE-1 time steps  
    130       !!                               averaging period (including Asselin  
    131       !!                               terms) 
    132       !!                  ztmlres(,) : residual = dh/dt entrainment 
    133       !! 
    134       !!      trends output in netCDF format using ioipsl 
    135       !! 
    136       !! History : 
    137       !!        !  95-04  (J. Vialard)  Original code 
    138       !!        !  97-02  (E. Guilyardi)  Adaptation global + base cmo 
    139       !!        !  99-09  (E. Guilyardi)  Re-writing + netCDF output 
    140       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    141       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    14282      !!---------------------------------------------------------------------- 
    143       !! * Arguments 
    144       INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
    145  
    146       CHARACTER(len=2), INTENT( in ) ::   & 
    147          ctype                                ! surface/bottom (2D arrays) or 
    148                                               ! interior (3D arrays) physics 
    149  
    150       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    151          pttrdmld,                         &  ! Temperature trend  
    152          pstrdmld                             ! Salinity    trend 
    153  
    154       !! * Local declarations 
     83      INTEGER, INTENT( in ) ::   ktrd                             ! ocean trend index 
     84      CHARACTER(len=2), INTENT( in ) :: ctype                     ! surface/bottom (2D arrays) or 
     85      !                                                           ! interior (3D arrays) physics 
     86      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  pttrdmld ! temperature trend  
     87      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  pstrdmld ! salinity trend  
    15588      INTEGER ::   ji, jj, jk, isum 
    156 # if defined key_trabbl_dif 
    157       INTEGER ::   ikb 
    158 # endif 
    159  
    160       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    161          zvlmsk 
     89      REAL(wp), DIMENSION(jpi,jpj) ::  zvlmsk 
    16290      !!---------------------------------------------------------------------- 
    16391 
     92      ! I. Definition of control surface and associated fields 
     93      ! ------------------------------------------------------ 
     94      !            ==> only once per time step <==  
     95 
    16496      IF( icount == 1 ) THEN         
    165  
    166          zvlmsk(:,:)   = 0.e0 
    167          tmltrd(:,:,:) = 0.e0 
    168          smltrd(:,:,:) = 0.e0 
    169           
    170          ! This computation should be done only once per time step 
    171  
    172          !  ======================================================== 
    173          !   I. definition of control surface and associated fields 
    174          !  ======================================================== 
    175  
    176          !    I.1 set nmld(ji,jj) = index of first T point below control surface 
    177          !    -------------------                       or outside mixed-layer 
    178  
    179          IF( nctls == 0 ) THEN 
    180             ! control surface = mixed-layer with density criterion  
    181             ! (array nmln computed in zdfmxl.F90) 
    182             nmld(:,:) = nmln(:,:) 
    183          ELSE IF( nctls == 1 ) THEN 
    184             ! control surface = read index from file  
     97         ! 
     98         tmltrd(:,:,:) = 0.e0    ;    smltrd(:,:,:) = 0.e0    ! <<< reset trend arrays to zero 
     99          
     100         ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer 
     101         IF( nctls == 0 ) THEN       ! * control surface = mixed-layer with density criterion  
     102            nmld(:,:) = nmln(:,:)    ! array nmln computed in zdfmxl.F90 
     103         ELSE IF( nctls == 1 ) THEN  ! * control surface = read index from file  
    185104            nmld(:,:) = nbol(:,:) 
    186          ELSE IF( nctls >= 2 ) THEN 
    187             ! control surface = model level 
     105         ELSE IF( nctls >= 2 ) THEN  ! * control surface = model level 
    188106            nctls = MIN( nctls, jpktrd - 1 ) 
    189107            nmld(:,:) = nctls + 1 
    190108         ENDIF 
    191109 
    192          IF( ionce == 1 ) THEN  ! compute ndextrd1 and ndimtrd1 only once 
    193             ! Check of validity : nmld(ji,jj) =< jpktrd 
    194             isum = 0 
     110         ! ... Compute ndextrd1 and ndimtrd1 only once 
     111         IF( ionce == 1 ) THEN 
     112            ! 
     113            ! Check of validity : nmld(ji,jj) <= jpktrd 
     114            isum        = 0 
     115            zvlmsk(:,:) = 0.e0 
    195116 
    196117            IF( jpktrd < jpk ) THEN  
    … …  
    215136            ENDIF                                 
    216137 
    217             ! no more pass here 
    218             ionce = 0 
    219  
    220          ENDIF 
    221           
    222          IF( idebug /= 0 ) THEN 
    223             ! CALL prihre (zvlmsk,jpi,jpj,1,jpi,2,1,jpj,2,3,numout) 
    224             WRITE(numout,*) ' debuging trd_mld_zint: I.1 done '   
    225             CALL FLUSH(numout) 
    226          ENDIF 
    227  
    228  
    229          ! I.2 probability density function of presence in mixed-layer 
    230          ! -------------------------------- 
    231          ! (i.e. weight of each grid point in vertical integration : wkx(ji,jj,jk) 
    232  
    233  
    234          ! initialize wkx with vertical scale factor in mixed-layer 
    235  
     138            ionce = 0                ! no more pass here 
     139            ! 
     140         END IF 
     141          
     142         ! ... Weights for vertical averaging 
    236143         wkx(:,:,:) = 0.e0 
    237          DO jk = 1, jpktrd 
     144         DO jk = 1, jpktrd             ! initialize wkx with vertical scale factor in mixed-layer 
    238145            DO jj = 1,jpj 
    239146               DO ji = 1,jpi 
    240                   IF( jk - nmld(ji,jj) < 0. )   wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
     147                  IF( jk - nmld(ji,jj) < 0.e0 )   wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
    241148               END DO 
    242149            END DO 
    243150         END DO 
    244151          
    245          ! compute mixed-layer depth : rmld 
    246           
    247          rmld(:,:) = 0. 
     152         rmld(:,:) = 0.e0                ! compute mixed-layer depth : rmld 
    248153         DO jk = 1, jpktrd 
    249154            rmld(:,:) = rmld(:,:) + wkx(:,:,jk) 
    250155         END DO 
    251156          
    252          ! compute PDF 
    253  
     157         DO jk = 1, jpktrd             ! compute integration weights 
     158            wkx(:,:,jk) = wkx(:,:,jk) / MAX( 1., rmld(:,:) ) 
     159         END DO 
     160 
     161         icount = 0                    ! <<< flag = off : control surface & integr. weights 
     162         !                             !     computed only once per time step 
     163      END IF 
     164 
     165      ! II. Vertical integration of trends in the mixed-layer 
     166      ! ----------------------------------------------------- 
     167 
     168      SELECT CASE (ctype) 
     169      CASE ( '3D' )   ! mean T/S trends in the mixed-layer 
    254170         DO jk = 1, jpktrd 
    255             wkx(:,:,jk) = wkx(:,:,jk) / MAX( 1., rmld(:,:) ) 
    256          END DO 
    257  
    258          IF( idebug /= 0 ) THEN 
    259             WRITE(numout,*) ' debuging trd_mld_zint: I.2 done '   
    260             CALL FLUSH(numout) 
    261          ENDIF 
    262  
    263          ! Set counter icount to 0 to avoid this part at each time step 
    264          icount = 0 
    265  
    266       ENDIF 
    267  
    268  
    269       !  ==================================================== 
    270       !   II. vertical integration of trends in mixed-layer 
    271       !  ==================================================== 
    272  
    273       ! II.1 vertical integration of 3D and 2D trends 
    274       ! --------------------------------------------- 
    275  
    276       SELECT CASE (ctype) 
    277  
    278       CASE ('3D')       ! 3D treatment 
    279  
    280          ! trends terms in the mixed-layer 
    281          DO jk = 1, jpktrd 
    282             ! Temperature 
    283             tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,jk) * wkx(:,:,jk)    
    284  
    285             ! Salinity 
    286             smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,jk) * wkx(:,:,jk)    
    287          ENDDO 
    288  
    289       CASE ('2D')       ! 2D treatment 
    290  
    291          SELECT CASE (ktrd)  
    292  
    293          CASE (jpmldldf) 
    294  
    295 # if defined key_trabbl_dif 
    296                ! trends terms from Beckman over-flow parameterization 
    297                DO jj = 1,jpj 
    298                   DO ji = 1,jpi 
    299                      ikb = MAX( mbathy(ji,jj)-1, 1 ) 
    300                      ! beckmann component -> horiz. part of lateral diffusion 
    301                      tmltrd(ji,jj,ktrd) = tmltrd(ji,jj,ktrd) + pttrdmld(ji,jj,1) * wkx(ji,jj,ikb) 
    302                      smltrd(ji,jj,ktrd) = smltrd(ji,jj,ktrd) + pstrdmld(ji,jj,1) * wkx(ji,jj,ikb) 
    303                   END DO 
    304                END DO 
    305 # endif 
    306  
    307          CASE DEFAULT 
    308  
    309             ! trends terms at upper boundary of mixed-layer 
    310  
    311             ! forcing term (non penetrative) 
    312             ! Temperature 
    313             tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,1) * wkx(:,:,1)    
    314  
    315             ! forcing term 
    316             ! Salinity 
    317             smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,1) * wkx(:,:,1)    
    318  
    319          END SELECT 
    320  
     171            tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,jk) * wkx(:,:,jk)   ! temperature 
     172            smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,jk) * wkx(:,:,jk)   ! salinity 
     173         END DO 
     174      CASE ( '2D' )   ! forcing at upper boundary of the mixed-layer 
     175         tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,1) * wkx(:,:,1)        ! non penetrative 
     176         smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,1) * wkx(:,:,1)             
    321177      END SELECT 
    322  
    323       IF( idebug /= 0 ) THEN 
    324          IF(lwp) WRITE(numout,*) ' debuging trd_mld_zint: II.1 done'   
    325          CALL FLUSH(numout) 
    326       ENDIF 
    327  
     178      ! 
    328179   END SUBROUTINE trd_mld_zint 
    329  
    330  
     180     
    331181 
    332182   SUBROUTINE trd_mld( kt ) 
    … …  
    334184      !!                  ***  ROUTINE trd_mld  *** 
    335185      !!  
    336       !! ** Purpose :  computation of cumulated trends over analysis period 
    337       !!               and make outputs (NetCDF or DIMG format) 
     186      !! ** Purpose :  Compute and cumulate the mixed layer trends over an analysis 
     187      !!               period, and write NetCDF (or dimg) outputs. 
    338188      !! 
    339189      !! ** Method/usage : 
     190      !!          The stored trends can be chosen twofold (according to the ln_trdmld_instant  
     191      !!          logical namelist variable) : 
     192      !!          1) to explain the difference between initial and final  
     193      !!             mixed-layer T & S (where initial and final relate to the 
     194      !!             current analysis window, defined by ntrd in the namelist) 
     195      !!          2) to explain the difference between the current and previous  
     196      !!             TIME-AVERAGED mixed-layer T & S (where time-averaging is 
     197      !!             performed over each analysis window). 
    340198      !! 
    341       !! History : 
    342       !!   9.0  !  04-08  (C. Talandier) New trends organization 
     199      !! ** Consistency check :  
     200      !!        If the control surface is fixed ( nctls > 1 ), the residual term (dh/dt 
     201      !!        entrainment) should be zero, at machine accuracy. Note that in the case 
     202      !!        of time-averaged mixed-layer fields, this residual WILL NOT BE ZERO 
     203      !!        over the first two analysis windows (except if restart). 
     204      !!        N.B. For ORCA2_LIM, use e.g. ntrd=5, ucf=1., nctls=8 
     205      !!             for checking residuals. 
     206      !!             On a NEC-SX5 computer, this typically leads to: 
     207      !!                   O(1.e-20) temp. residuals (tml_res) when ln_trdmld_instant=.false. 
     208      !!                   O(1.e-21) temp. residuals (tml_res) when ln_trdmld_instant=.true. 
     209      !! 
     210      !! ** Action : 
     211      !!       At each time step, mixed-layer averaged trends are stored in the  
     212      !!       tmltrd(:,:,jpmld_xxx) array (see trdmld_oce.F90 for definitions of jpmld_xxx). 
     213      !!       This array is known when trd_mld is called, at the end of the stp subroutine,  
     214      !!       except for the purely vertical K_z diffusion term, which is embedded in the 
     215      !!       lateral diffusion trend. 
     216      !! 
     217      !!       In I), this K_z term is diagnosed and stored, thus its contribution is removed 
     218      !!       from the lateral diffusion trend. 
     219      !!       In II), the instantaneous mixed-layer T & S are computed, and misc. cumulative 
     220      !!       arrays are updated. 
     221      !!       In III), called only once per analysis window, we compute the total trends, 
     222      !!       along with the residuals and the Asselin correction terms. 
     223      !!       In IV), the appropriate trends are written in the trends NetCDF file. 
     224      !! 
     225      !! References : 
     226      !!       - Vialard & al. 
     227      !!       - See NEMO documentation (in preparation) 
    343228      !!---------------------------------------------------------------------- 
    344       !! * Arguments 
    345229      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    346  
    347       !! * Local declarations 
     230      !! 
    348231      INTEGER :: ji, jj, jk, jl, ik, it 
    349  
    350       REAL(wp) :: zmean, zavt 
    351  
    352       REAL(wp) ,DIMENSION(jpi,jpj) ::   & 
    353          ztmltot, ztmlres,              & 
    354          zsmltot, zsmlres,              &  
    355          z2d 
    356  
     232      LOGICAL :: lldebug = .TRUE. 
     233      REAL(wp) :: zavt, zfn, zfn2 
     234      REAL(wp) ,DIMENSION(jpi,jpj) ::     & 
     235           ztmltot,  zsmltot,             & ! dT/dt over the anlysis window (including Asselin) 
     236           ztmlres,  zsmlres,             & ! residual = dh/dt entrainment term 
     237           ztmlatf,  zsmlatf,             & ! needed for storage only 
     238           ztmltot2, ztmlres2, ztmltrdm2, & ! \  working arrays to diagnose the trends 
     239           zsmltot2, zsmlres2, zsmltrdm2, & !  > associated with the time meaned ML T & S 
     240           ztmlatf2, zsmlatf2               ! / 
     241      REAL(wp), DIMENSION(jpi,jpj,jpltrd) ::  & 
     242           ztmltrd2, zsmltrd2               ! only needed for mean diagnostics 
    357243#if defined key_dimgout 
    358244      INTEGER ::  iyear,imon,iday 
    … …  
    361247      !!---------------------------------------------------------------------- 
    362248 
    363       ! I. trends terms at lower boundary of mixed-layer 
    364       ! ------------------------------------------------ 
    365  
     249      ! ====================================================================== 
     250      ! I. Diagnose the purely vertical (K_z) diffusion trend 
     251      ! ====================================================================== 
     252 
     253      ! ... These terms can be estimated by flux computation at the lower boundary of the ML  
     254      !     (we compute (-1/h) * K_z * d_z( T ) and (-1/h) * K_z * d_z( S )) 
    366255      DO jj = 1,jpj 
    367256         DO ji = 1,jpi 
    368              
    369257            ik = nmld(ji,jj) 
    370              
    371             ! Temperature 
    372             ! entrainment due to vertical diffusion 
    373             !       - due to vertical mixing scheme (TKE) 
    374258            zavt = avt(ji,jj,ik) 
    375             tmltrd(ji,jj,jpmldevd) = - 1. * zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)   & 
    376                &                   * ( tn(ji,jj,ik-1) - tn(ji,jj,ik) )   & 
    377                &                   / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 
    378             ! Salinity 
    379             ! entrainment due to vertical diffusion 
    380             !       - due to vertical mixing scheme (TKE) 
     259            tmltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
     260               &                      * ( tn(ji,jj,ik-1) - tn(ji,jj,ik) )         & 
     261               &                      / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 
    381262            zavt = fsavs(ji,jj,ik) 
    382             smltrd(ji,jj,jpmldevd) = -1. * zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)   & 
    383                &                  * ( sn(ji,jj,ik-1) - sn(ji,jj,ik) )   & 
    384                &                  / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 
     263            smltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
     264               &                      * ( sn(ji,jj,ik-1) - sn(ji,jj,ik) )         & 
     265               &                      / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 
    385266         END DO 
    386267      END DO 
    387268 
     269      ! ... Remove this K_z trend from the iso-neutral diffusion term (if any) 
    388270      IF( ln_traldf_iso ) THEN 
    389          ! We substract to the TOTAL vertical diffusion tmltrd(:,:,jpmldzdf)  
    390          ! computed in subroutines trazdf_iso.F90 or trazdf_imp.F90 
    391          ! the vertical part du to the Kz in order to keep only the vertical 
    392          ! isopycnal diffusion (i.e the isopycnal diffusion componant on the vertical): 
    393          tmltrd(:,:,jpmldzdf) = tmltrd(:,:,jpmldzdf) - tmltrd(:,:,jpmldevd)   ! - due to isopycnal mixing scheme (implicit part) 
    394          smltrd(:,:,jpmldzdf) = smltrd(:,:,jpmldzdf) - smltrd(:,:,jpmldevd)   ! - due to isopycnal mixing scheme (implicit part) 
    395       ENDIF 
    396  
    397       ! Boundary conditions 
    398       CALL lbc_lnk( tmltrd, 'T', 1. ) 
    399       CALL lbc_lnk( smltrd, 'T', 1. ) 
    400  
    401       IF( idebug /= 0 ) THEN 
    402          WRITE(numout,*) ' debuging trd_mld: I. done'   
    403          CALL FLUSH(numout) 
    404       ENDIF 
    405  
    406       !  ================================= 
    407       !   II. Cumulated trends 
    408       !  ================================= 
    409  
    410       ! II.1 set before values of vertically average T and S  
    411       ! --------------------------------------------------- 
    412  
     271         tmltrd(:,:,jpmld_ldf) = tmltrd(:,:,jpmld_ldf) - tmltrd(:,:,jpmld_zdf) 
     272         smltrd(:,:,jpmld_ldf) = smltrd(:,:,jpmld_ldf) - smltrd(:,:,jpmld_zdf) 
     273      END IF 
     274 
     275      ! ... Lateral boundary conditions 
     276      DO jl = 1, jpltrd 
     277         CALL lbc_lnk( tmltrd(:,:,jl), 'T', 1. ) 
     278         CALL lbc_lnk( smltrd(:,:,jl), 'T', 1. ) 
     279      END DO 
     280 
     281      ! ====================================================================== 
     282      ! II. Cumulate the trends over the analysis window 
     283      ! ====================================================================== 
     284 
     285      ztmltrd2(:,:,:) = 0.e0   ;    zsmltrd2(:,:,:) = 0.e0  ! <<< reset arrays to zero 
     286      ztmltot2(:,:)   = 0.e0   ;    zsmltot2(:,:)   = 0.e0 
     287      ztmlres2(:,:)   = 0.e0   ;    zsmlres2(:,:)   = 0.e0 
     288      ztmlatf2(:,:)   = 0.e0   ;    zsmlatf2(:,:)   = 0.e0 
     289 
     290      ! II.1 Set before values of vertically average T and S  
     291      ! ---------------------------------------------------- 
    413292      IF( kt > nit000 ) THEN 
    414          tmlb(:,:) = tml(:,:) 
    415          smlb(:,:) = sml(:,:) 
    416       ENDIF 
    417  
    418       ! II.2 vertically integrated T and S 
    419       ! --------------------------------- 
    420  
    421       tml(:,:) = 0. 
    422       sml(:,:) = 0. 
    423  
     293         !   ... temperature ...                    ... salinity ... 
     294         tmlb   (:,:) = tml   (:,:)           ; smlb   (:,:) = sml   (:,:) 
     295         tmlatfn(:,:) = tmltrd(:,:,jpmld_atf) ; smlatfn(:,:) = smltrd(:,:,jpmld_atf) 
     296      END IF 
     297 
     298      ! II.2 Vertically averaged T and S 
     299      ! -------------------------------- 
     300      tml(:,:) = 0.e0   ;   sml(:,:) = 0.e0 
    424301      DO jk = 1, jpktrd - 1 
    425302         tml(:,:) = tml(:,:) + wkx(:,:,jk) * tn(:,:,jk) 
    … …  
    427304      END DO 
    428305 
    429       IF(idebug /= 0) THEN 
    430          WRITE(numout,*) ' debuging trd_mld: II.2 done'   
    431          CALL FLUSH(numout) 
    432       ENDIF 
    433  
    434       ! II.3 set `before' mixed layer values for kt = nit000+1 
    435       ! -------------------------------------------------------- 
    436  
    437       IF( kt == nit000+1 ) THEN 
    438          tmlbb(:,:) = tmlb(:,:) 
    439          tmlbn(:,:) = tml (:,:) 
    440          smlbb(:,:) = smlb(:,:) 
    441          smlbn(:,:) = sml (:,:) 
    442       ENDIF 
    443  
    444       IF( idebug /= 0 ) THEN 
    445          WRITE(numout,*) ' debuging trd_mld: II.3 done'   
    446          CALL FLUSH(numout) 
    447       ENDIF 
    448  
    449       ! II.4 cumulated trends over analysis period (kt=2 to nwrite) 
    450       ! ----------------------------------------------------------- 
    451  
    452       ! trends cumulated over nwrite-2 time steps 
    453  
    454       IF( kt >= nit000+2 ) THEN 
     306      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window     
     307      ! ------------------------------------------------------------------------ 
     308      IF( kt == 2 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) 
     309         ! 
     310         !   ... temperature ...                ... salinity ... 
     311         tmlbb  (:,:) = tmlb   (:,:)   ;   smlbb  (:,:) = smlb   (:,:) 
     312         tmlbn  (:,:) = tml    (:,:)   ;   smlbn  (:,:) = sml    (:,:) 
     313         tmlatfb(:,:) = tmlatfn(:,:)   ;   smlatfb(:,:) = smlatfn(:,:) 
     314          
     315         tmltrd_csum_ub (:,:,:) = 0.e0  ;   smltrd_csum_ub (:,:,:) = 0.e0 
     316         tmltrd_atf_sumb(:,:)   = 0.e0  ;   smltrd_atf_sumb(:,:)   = 0.e0 
     317 
     318         rmldbn(:,:) = rmld(:,:) 
     319 
     320         IF( ln_ctl ) THEN 
     321            WRITE(numout,*) '             we reach kt == nit000 + 1 = ', nit000+1 
     322            CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask, ovlap=1) 
     323            CALL prt_ctl(tab2d_1=tmlbn   , clinfo1=' tmlbn   -   : ', mask1=tmask, ovlap=1) 
     324            CALL prt_ctl(tab2d_1=tmlatfb , clinfo1=' tmlatfb -   : ', mask1=tmask, ovlap=1) 
     325         END IF 
     326         ! 
     327      END IF 
     328 
     329      IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. ( ln_ctl ) ) THEN 
     330         IF( ln_trdmld_instant ) THEN 
     331            WRITE(numout,*) '             restart from kt == nit000 = ', nit000 
     332            CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask, ovlap=1) 
     333            CALL prt_ctl(tab2d_1=tmlbn   , clinfo1=' tmlbn   -   : ', mask1=tmask, ovlap=1) 
     334            CALL prt_ctl(tab2d_1=tmlatfb , clinfo1=' tmlatfb -   : ', mask1=tmask, ovlap=1) 
     335         ELSE 
     336            WRITE(numout,*) '             restart from kt == nit000 = ', nit000 
     337            CALL prt_ctl(tab2d_1=tmlbn          , clinfo1=' tmlbn           -  : ', mask1=tmask, ovlap=1) 
     338            CALL prt_ctl(tab2d_1=rmldbn         , clinfo1=' rmldbn          -  : ', mask1=tmask, ovlap=1) 
     339            CALL prt_ctl(tab2d_1=tml_sumb       , clinfo1=' tml_sumb        -  : ', mask1=tmask, ovlap=1) 
     340            CALL prt_ctl(tab2d_1=tmltrd_atf_sumb, clinfo1=' tmltrd_atf_sumb -  : ', mask1=tmask, ovlap=1) 
     341            CALL prt_ctl(tab3d_1=tmltrd_csum_ub , clinfo1=' tmltrd_csum_ub  -  : ', mask1=tmask, ovlap=1, kdim=1) 
     342         END IF 
     343      END IF 
     344 
     345      ! II.4 Cumulated trends over the analysis period 
     346      ! ---------------------------------------------- 
     347      ! 
     348      !         [  1rst analysis window ] [     2nd analysis window     ]                        
     349      ! 
     350      !     o---[--o-----o-----o-----o--]-[--o-----o-----o-----o-----o--]---o-----o--> time steps 
     351      !                            ntrd                             2*ntrd       etc. 
     352      !     1      2     3     4    =5 e.g.                          =10 
     353      ! 
     354      IF( ( kt >= 2 ).OR.( ln_rstart ) ) THEN 
     355         ! 
    455356         nmoymltrd = nmoymltrd + 1 
     357          
     358         ! ... Cumulate over BOTH physical contributions AND over time steps 
    456359         DO jl = 1, jpltrd 
    457360            tmltrdm(:,:) = tmltrdm(:,:) + tmltrd(:,:,jl) 
    458361            smltrdm(:,:) = smltrdm(:,:) + smltrd(:,:,jl) 
    459362         END DO 
    460       ENDIF 
    461  
    462       IF( idebug /= 0 ) THEN 
    463          WRITE(numout,*) ' debuging trd_mld: II.4 done'   
    464          CALL FLUSH(numout) 
    465       ENDIF 
    466  
    467       !  ============================================= 
    468       !   III. Output in netCDF + residual computation 
    469       !  ============================================= 
    470  
    471       ztmltot(:,:) = 0. 
    472       zsmltot(:,:) = 0. 
    473       ztmlres(:,:) = 0. 
    474       zsmlres(:,:) = 0. 
    475  
    476       IF( MOD( kt - nit000+1, nwrite ) == 0 ) THEN 
    477  
    478          ! III.1 compute total trend  
    479          ! ------------------------ 
    480  
    481          zmean = float(nmoymltrd) 
    482           
    483          ztmltot(:,:) = ( tml(:,:) - tmlbn(:,:) + tmlb(:,:) - tmlbb(:,:) ) /  (zmean * 2. * rdt) 
    484          zsmltot(:,:) = ( sml(:,:) - smlbn(:,:) + smlb(:,:) - smlbb(:,:) ) /  (zmean * 2. * rdt) 
    485  
    486          IF(idebug /= 0) THEN 
    487             WRITE(numout,*) ' zmean = ',zmean   
    488             WRITE(numout,*) ' debuging trd_mld: III.1 done'   
    489             CALL FLUSH(numout) 
    490          ENDIF 
    491            
    492  
    493          ! III.2 compute residual  
    494          ! --------------------- 
    495  
    496          ztmlres(:,:) = ztmltot(:,:) - tmltrdm(:,:) / zmean 
    497          zsmlres(:,:) = zsmltot(:,:) - smltrdm(:,:) / zmean 
    498  
    499  
    500          ! Boundary conditions 
    501  
    502          CALL lbc_lnk( ztmltot, 'T', 1. ) 
    503          CALL lbc_lnk( ztmlres, 'T', 1. ) 
    504          CALL lbc_lnk( zsmltot, 'T', 1. ) 
    505          CALL lbc_lnk( zsmlres, 'T', 1. ) 
    506  
    507          IF( idebug /= 0 ) THEN 
    508             WRITE(numout,*) ' debuging trd_mld: III.2 done'   
    509             CALL FLUSH(numout) 
    510          ENDIF 
    511  
    512  
    513          ! III.3 time evolution array swap 
    514          ! ------------------------------ 
    515  
    516          tmlbb(:,:) = tmlb(:,:) 
    517          tmlbn(:,:) = tml (:,:) 
    518          smlbb(:,:) = smlb(:,:) 
    519          smlbn(:,:) = sml (:,:) 
    520  
    521          IF( idebug /= 0 ) THEN 
    522             WRITE(numout,*) ' debuging trd_mld: III.3 done'   
    523             CALL FLUSH(numout) 
    524          ENDIF 
    525  
    526  
    527          ! III.4 zero cumulative array 
    528          ! --------------------------- 
    529  
    530           nmoymltrd = 0 
    531  
    532           tmltrdm(:,:) = 0. 
    533           smltrdm(:,:) = 0. 
    534  
    535           IF(idebug /= 0) THEN 
    536               WRITE(numout,*) ' debuging trd_mld: III.4 done'   
    537               CALL FLUSH(numout) 
    538           ENDIF 
    539            
    540       ENDIF 
    541  
    542       ! III.5 write trends to output 
    543       ! --------------------------- 
     363 
     364         ! ... Special handling of the Asselin trend  
     365         tmlatfm(:,:) = tmlatfm(:,:) + tmlatfn(:,:) 
     366         smlatfm(:,:) = smlatfm(:,:) + smlatfn(:,:) 
     367 
     368         ! ... Trends associated with the time mean of the ML T/S 
     369         tmltrd_sum    (:,:,:) = tmltrd_sum    (:,:,:) + tmltrd    (:,:,:) ! tem 
     370         tmltrd_csum_ln(:,:,:) = tmltrd_csum_ln(:,:,:) + tmltrd_sum(:,:,:) 
     371         tml_sum       (:,:)   = tml_sum       (:,:)   + tml       (:,:) 
     372         smltrd_sum    (:,:,:) = smltrd_sum    (:,:,:) + smltrd    (:,:,:) ! sal 
     373         smltrd_csum_ln(:,:,:) = smltrd_csum_ln(:,:,:) + smltrd_sum(:,:,:) 
     374         sml_sum       (:,:)   = sml_sum       (:,:)   + sml       (:,:) 
     375         rmld_sum      (:,:)   = rmld_sum      (:,:)   + rmld      (:,:)   ! rmld 
     376         ! 
     377      END IF 
     378 
     379      ! ====================================================================== 
     380      ! III. Prepare fields for output (get here ONCE PER ANALYSIS PERIOD) 
     381      ! ====================================================================== 
     382 
     383      ! Convert to appropriate physical units 
     384      ! N.B. It may be useful to check IOIPSL time averaging with : 
     385      !      tmltrd (:,:,:) = 1. ; smltrd (:,:,:) = 1. 
     386      tmltrd(:,:,:) = tmltrd(:,:,:) * ucf   ! (actually needed for 1:jpltrd-1, but trdmld(:,:,jpltrd) 
     387      smltrd(:,:,:) = smltrd(:,:,:) * ucf   !  is no longer used, and is reset to 0. at next time step) 
     388       
     389      MODULO_NTRD : IF( MOD( kt, ntrd ) == 0 ) THEN        ! nitend MUST be multiple of ntrd 
     390         ! 
     391         ztmltot (:,:) = 0.e0   ;   zsmltot (:,:) = 0.e0   ! reset arrays to zero 
     392         ztmlres (:,:) = 0.e0   ;   zsmlres (:,:) = 0.e0 
     393         ztmltot2(:,:) = 0.e0   ;   zsmltot2(:,:) = 0.e0 
     394         ztmlres2(:,:) = 0.e0   ;   zsmlres2(:,:) = 0.e0 
     395       
     396         zfn  = float(nmoymltrd)    ;    zfn2 = zfn * zfn 
     397          
     398         ! III.1 Prepare fields for output ("instantaneous" diagnostics)  
     399         ! ------------------------------------------------------------- 
     400          
     401         !-- Compute total trends 
     402         ztmltot(:,:) = ( tml(:,:) - tmlbn(:,:) + tmlb(:,:) - tmlbb(:,:) ) / ( 2.*rdt ) 
     403         zsmltot(:,:) = ( sml(:,:) - smlbn(:,:) + smlb(:,:) - smlbb(:,:) ) / ( 2.*rdt ) 
     404          
     405         !-- Compute residuals 
     406         ztmlres(:,:) = ztmltot(:,:) - ( tmltrdm(:,:) - tmlatfn(:,:) + tmlatfb(:,:) ) 
     407         zsmlres(:,:) = zsmltot(:,:) - ( smltrdm(:,:) - smlatfn(:,:) + smlatfb(:,:) ) 
     408       
     409         !-- Diagnose Asselin trend over the analysis window  
     410         ztmlatf(:,:) = tmlatfm(:,:) - tmlatfn(:,:) + tmlatfb(:,:) 
     411         zsmlatf(:,:) = smlatfm(:,:) - smlatfn(:,:) + smlatfb(:,:) 
     412          
     413         !-- Lateral boundary conditions 
     414         !         ... temperature ...                    ... salinity ... 
     415         CALL lbc_lnk( ztmltot , 'T', 1. )  ;   CALL lbc_lnk( zsmltot , 'T', 1. ) 
     416         CALL lbc_lnk( ztmlres , 'T', 1. )  ;   CALL lbc_lnk( zsmlres , 'T', 1. ) 
     417         CALL lbc_lnk( ztmlatf , 'T', 1. )  ;   CALL lbc_lnk( zsmlatf , 'T', 1. ) 
     418 
     419#if defined key_diainstant 
     420         CALL ctl_stop( 'tml_trd : key_diainstant was never checked within trdmld. Comment this to proceed.') 
     421#endif 
     422         ! III.2 Prepare fields for output ("mean" diagnostics)  
     423         ! ---------------------------------------------------- 
     424          
     425         !-- Update the ML depth time sum (to build the Leap-Frog time mean) 
     426         rmld_sum(:,:) = rmldbn(:,:) + 2 * ( rmld_sum(:,:) - rmld(:,:) ) + rmld(:,:) 
     427 
     428         !-- Compute temperature total trends 
     429         tml_sum (:,:) = tmlbn(:,:) + 2 * ( tml_sum(:,:) - tml(:,:) ) + tml(:,:) 
     430         ztmltot2(:,:) = ( tml_sum(:,:) - tml_sumb(:,:) ) /  ( 2.*rdt )    ! now in degC/s 
     431          
     432         !-- Compute salinity total trends 
     433         sml_sum (:,:) = smlbn(:,:) + 2 * ( sml_sum(:,:) - sml(:,:) ) + sml(:,:) 
     434         zsmltot2(:,:) = ( sml_sum(:,:) - sml_sumb(:,:) ) /  ( 2.*rdt )    ! now in psu/s 
     435          
     436         !-- Compute temperature residuals 
     437         DO jl = 1, jpltrd 
     438            ztmltrd2(:,:,jl) = tmltrd_csum_ub(:,:,jl) + tmltrd_csum_ln(:,:,jl) 
     439         END DO 
     440 
     441         ztmltrdm2(:,:) = 0.e0 
     442         DO jl = 1, jpltrd 
     443            ztmltrdm2(:,:) = ztmltrdm2(:,:) + ztmltrd2(:,:,jl) 
     444         END DO 
     445 
     446         ztmlres2(:,:) =  ztmltot2(:,:)  -       & 
     447              ( ztmltrdm2(:,:) - tmltrd_sum(:,:,jpmld_atf) + tmltrd_atf_sumb(:,:) ) 
     448          
     449         !-- Compute salinity residuals 
     450         DO jl = 1, jpltrd 
     451            zsmltrd2(:,:,jl) = smltrd_csum_ub(:,:,jl) + smltrd_csum_ln(:,:,jl) 
     452         END DO 
     453 
     454         zsmltrdm2(:,:) = 0. 
     455         DO jl = 1, jpltrd 
     456            zsmltrdm2(:,:) = zsmltrdm2(:,:) + zsmltrd2(:,:,jl) 
     457         END DO 
     458 
     459         zsmlres2(:,:) =  zsmltot2(:,:)  -       & 
     460              ( zsmltrdm2(:,:) - smltrd_sum(:,:,jpmld_atf) + smltrd_atf_sumb(:,:) ) 
     461          
     462         !-- Diagnose Asselin trend over the analysis window 
     463         ztmlatf2(:,:) = ztmltrd2(:,:,jpmld_atf) - tmltrd_sum(:,:,jpmld_atf) + tmltrd_atf_sumb(:,:) 
     464         zsmlatf2(:,:) = zsmltrd2(:,:,jpmld_atf) - smltrd_sum(:,:,jpmld_atf) + smltrd_atf_sumb(:,:) 
     465 
     466         !-- Lateral boundary conditions 
     467         !         ... temperature ...                    ... salinity ... 
     468         CALL lbc_lnk( ztmltot2, 'T', 1. )  ;   CALL lbc_lnk( zsmltot2, 'T', 1. ) 
     469         CALL lbc_lnk( ztmlres2, 'T', 1. )  ;   CALL lbc_lnk( zsmlres2, 'T', 1. ) 
     470         DO jl = 1, jpltrd 
     471            CALL lbc_lnk( ztmltrd2(:,:,jl), 'T', 1. ) ! \  these will be output 
     472            CALL lbc_lnk( zsmltrd2(:,:,jl), 'T', 1. ) ! /  in the NetCDF trends file 
     473         END DO 
     474          
     475         ! III.3 Time evolution array swap 
     476         ! ------------------------------- 
     477          
     478         ! For T/S instantaneous diagnostics  
     479         !   ... temperature ...               ... salinity ... 
     480         tmlbb  (:,:) = tmlb   (:,:)  ;   smlbb  (:,:) = smlb   (:,:) 
     481         tmlbn  (:,:) = tml    (:,:)  ;   smlbn  (:,:) = sml    (:,:) 
     482         tmlatfb(:,:) = tmlatfn(:,:)  ;   smlatfb(:,:) = smlatfn(:,:) 
     483 
     484         ! For T mean diagnostics  
     485         tmltrd_csum_ub (:,:,:) = zfn * tmltrd_sum(:,:,:) - tmltrd_csum_ln(:,:,:) 
     486         tml_sumb       (:,:)   = tml_sum(:,:) 
     487         tmltrd_atf_sumb(:,:)   = tmltrd_sum(:,:,jpmld_atf) 
     488          
     489         ! For S mean diagnostics  
     490         smltrd_csum_ub (:,:,:) = zfn * smltrd_sum(:,:,:) - smltrd_csum_ln(:,:,:) 
     491         sml_sumb       (:,:)   = sml_sum(:,:) 
     492         smltrd_atf_sumb(:,:)   = smltrd_sum(:,:,jpmld_atf) 
     493          
     494         ! ML depth 
     495         rmldbn         (:,:)   = rmld    (:,:) 
     496          
     497         IF( ln_ctl ) THEN 
     498            IF( ln_trdmld_instant ) THEN 
     499               CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask, ovlap=1) 
     500               CALL prt_ctl(tab2d_1=tmlbn   , clinfo1=' tmlbn   -   : ', mask1=tmask, ovlap=1) 
     501               CALL prt_ctl(tab2d_1=tmlatfb , clinfo1=' tmlatfb -   : ', mask1=tmask, ovlap=1) 
     502            ELSE 
     503               CALL prt_ctl(tab2d_1=tmlbn          , clinfo1=' tmlbn           -  : ', mask1=tmask, ovlap=1) 
     504               CALL prt_ctl(tab2d_1=rmldbn         , clinfo1=' rmldbn          -  : ', mask1=tmask, ovlap=1) 
     505               CALL prt_ctl(tab2d_1=tml_sumb       , clinfo1=' tml_sumb        -  : ', mask1=tmask, ovlap=1) 
     506               CALL prt_ctl(tab2d_1=tmltrd_atf_sumb, clinfo1=' tmltrd_atf_sumb -  : ', mask1=tmask, ovlap=1) 
     507               CALL prt_ctl(tab3d_1=tmltrd_csum_ub , clinfo1=' tmltrd_csum_ub  -  : ', mask1=tmask, ovlap=1, kdim=1) 
     508            END IF 
     509         END IF 
     510 
     511         ! III.4 Convert to appropriate physical units 
     512         ! ------------------------------------------- 
     513 
     514         !    ... temperature ...                         ... salinity ... 
     515         ztmltot (:,:)   = ztmltot(:,:)   * ucf/zfn  ; zsmltot (:,:)   = zsmltot(:,:)   * ucf/zfn 
     516         ztmlres (:,:)   = ztmlres(:,:)   * ucf/zfn  ; zsmlres (:,:)   = zsmlres(:,:)   * ucf/zfn 
     517         ztmlatf (:,:)   = ztmlatf(:,:)   * ucf/zfn  ; zsmlatf (:,:)   = zsmlatf(:,:)   * ucf/zfn 
     518 
     519         tml_sum (:,:)   = tml_sum (:,:)  /  (2*zfn) ; sml_sum (:,:)   = sml_sum (:,:)  /  (2*zfn) 
     520         ztmltot2(:,:)   = ztmltot2(:,:)  * ucf/zfn2 ; zsmltot2(:,:)   = zsmltot2(:,:)  * ucf/zfn2 
     521         ztmltrd2(:,:,:) = ztmltrd2(:,:,:)* ucf/zfn2 ; zsmltrd2(:,:,:) = zsmltrd2(:,:,:)* ucf/zfn2 
     522         ztmlatf2(:,:)   = ztmlatf2(:,:)  * ucf/zfn2 ; zsmlatf2(:,:)   = zsmlatf2(:,:)  * ucf/zfn2 
     523         ztmlres2(:,:)   = ztmlres2(:,:)  * ucf/zfn2 ; zsmlres2(:,:)   = zsmlres2(:,:)  * ucf/zfn2 
     524 
     525         rmld_sum(:,:)   = rmld_sum(:,:)  /  (2*zfn)  ! similar to tml_sum and sml_sum 
     526 
     527         ! * Debugging information * 
     528         IF( lldebug ) THEN 
     529            ! 
     530            WRITE(numout,*) 
     531            WRITE(numout,*) 'trd_mld : write trends in the Mixed Layer for debugging process:' 
     532            WRITE(numout,*) '~~~~~~~  ' 
     533            WRITE(numout,*) '          TRA kt = ', kt, 'nmoymltrd = ', nmoymltrd 
     534            WRITE(numout,*) 
     535            WRITE(numout,*) '          >>>>>>>>>>>>>>>>>>  TRA TEMPERATURE <<<<<<<<<<<<<<<<<<' 
     536            WRITE(numout,*) '          TRA ztmlres    : ', SUM(ztmlres(:,:)) 
     537            WRITE(numout,*) '          TRA ztmltot    : ', SUM(ztmltot(:,:)) 
     538            WRITE(numout,*) '          TRA tmltrdm    : ', SUM(tmltrdm(:,:)) 
     539            WRITE(numout,*) '          TRA tmlatfb    : ', SUM(tmlatfb(:,:)) 
     540            WRITE(numout,*) '          TRA tmlatfn    : ', SUM(tmlatfn(:,:)) 
     541            DO jl = 1, jpltrd 
     542               WRITE(numout,*) '          * TRA TREND INDEX jpmld_xxx = jl = ', jl, & 
     543                    & ' tmltrd : ', SUM(tmltrd(:,:,jl)) 
     544            END DO 
     545            WRITE(numout,*) '          TRA ztmlres (jpi/2,jpj/2) : ', ztmlres (jpi/2,jpj/2) 
     546            WRITE(numout,*) '          TRA ztmlres2(jpi/2,jpj/2) : ', ztmlres2(jpi/2,jpj/2) 
     547            WRITE(numout,*) 
     548            WRITE(numout,*) '          >>>>>>>>>>>>>>>>>>  TRA SALINITY <<<<<<<<<<<<<<<<<<' 
     549            WRITE(numout,*) '          TRA zsmlres    : ', SUM(zsmlres(:,:)) 
     550            WRITE(numout,*) '          TRA zsmltot    : ', SUM(zsmltot(:,:)) 
     551            WRITE(numout,*) '          TRA smltrdm    : ', SUM(smltrdm(:,:)) 
     552            WRITE(numout,*) '          TRA smlatfb    : ', SUM(smlatfb(:,:)) 
     553            WRITE(numout,*) '          TRA smlatfn    : ', SUM(smlatfn(:,:)) 
     554            DO jl = 1, jpltrd 
     555               WRITE(numout,*) '          * TRA TREND INDEX jpmld_xxx = jl = ', jl, & 
     556                    & ' smltrd : ', SUM(smltrd(:,:,jl)) 
     557            END DO 
     558            WRITE(numout,*) '          TRA zsmlres (jpi/2,jpj/2) : ', zsmlres (jpi/2,jpj/2) 
     559            WRITE(numout,*) '          TRA zsmlres2(jpi/2,jpj/2) : ', zsmlres2(jpi/2,jpj/2) 
     560            ! 
     561         END IF 
     562         ! 
     563      END IF MODULO_NTRD 
     564 
     565      ! ====================================================================== 
     566      ! IV. Write trends in the NetCDF file 
     567      ! ====================================================================== 
     568 
     569      ! IV.1 Code for dimg mpp output 
     570      ! ----------------------------- 
    544571 
    545572#if defined key_dimgout 
    546 ! code for dimg mpp output 
    547       IF ( MOD(kt,nwrite) == 0 ) THEN 
    548          WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average' 
    549          iyear = ndastp/10000 
    550          imon = (ndastp-iyear*10000)/100 
    551          iday = ndastp - imon*100 - iyear*10000 
     573 
     574      IF( MOD( kt, ntrd ) == 0 ) THEN 
     575         iyear =  ndastp/10000 
     576         imon  = (ndastp-iyear*10000)/100 
     577         iday  =  ndastp - imon*100 - iyear*10000 
    552578         WRITE(clname,9000) TRIM(cexper),'MLDiags',iyear,imon,iday 
    553          cltext=TRIM(cexper)//' mld diags'//TRIM(clmode) 
     579         WRITE(clmode,'(f5.1,a)') ntrd*rdt/86400.,' days average' 
     580         cltext = TRIM(cexper)//' mld diags'//TRIM(clmode) 
    554581         CALL dia_wri_dimg (clname, cltext, smltrd, jpltrd, '2') 
    555   9000   FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc") 
    556        END IF 
     582      END IF 
     583 
     5849000  FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc") 
    557585 
    558586#else 
    559       IF( kt >=  nit000+1 ) THEN 
    560  
    561          ! define time axis 
    562          it= kt-nit000+1 
    563          IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN 
    564             WRITE(numout,*) '     trd_mld : write NetCDF fields' 
    565          ENDIF 
    566           
    567          CALL histwrite( nidtrd,"somlttml",it,rmld          ,ndimtrd1,ndextrd1) ! Mixed-layer depth 
    568           
    569          ! Temperature trends 
    570          ! ------------------ 
    571          CALL histwrite( nidtrd,"somltemp",it,tml           ,ndimtrd1,ndextrd1) ! Mixed-layer temperature 
    572          CALL histwrite( nidtrd,"somlttto",it,ztmltot       ,ndimtrd1,ndextrd1) ! total  
    573          CALL histwrite( nidtrd,"somlttax",it,tmltrd(:,:, 1),ndimtrd1,ndextrd1) ! i- adv. 
    574          CALL histwrite( nidtrd,"somlttay",it,tmltrd(:,:, 2),ndimtrd1,ndextrd1) ! j- adv. 
    575          CALL histwrite( nidtrd,"somlttaz",it,tmltrd(:,:, 3),ndimtrd1,ndextrd1) ! vertical adv. 
    576          CALL histwrite( nidtrd,"somlttdh",it,tmltrd(:,:, 4),ndimtrd1,ndextrd1) ! hor. lateral diff. 
    577          CALL histwrite( nidtrd,"somlttfo",it,tmltrd(:,:, 5),ndimtrd1,ndextrd1) ! forcing 
    578  
    579          CALL histwrite( nidtrd,"somlbtdz",it,tmltrd(:,:, 6),ndimtrd1,ndextrd1) ! vert. diffusion  
    580          CALL histwrite( nidtrd,"somlbtdt",it,ztmlres       ,ndimtrd1,ndextrd1) ! dh/dt entrainment (residual) 
    581          IF( ln_traldf_iso ) THEN 
    582             CALL histwrite( nidtrd,"somlbtdv",it,tmltrd(:,:, 7),ndimtrd1,ndextrd1) ! vert. lateral diff. 
    583          ENDIF 
    584 #if defined key_traldf_eiv 
    585          CALL histwrite( nidtrd,"somlgtax",it,tmltrd(:,:, 8),ndimtrd1,ndextrd1) ! i- adv. (eiv) 
    586          CALL histwrite( nidtrd,"somlgtay",it,tmltrd(:,:, 9),ndimtrd1,ndextrd1) ! j- adv. (eiv) 
    587          CALL histwrite( nidtrd,"somlgtaz",it,tmltrd(:,:,10),ndimtrd1,ndextrd1) ! vert. adv. (eiv) 
    588          z2d(:,:) = tmltrd(:,:,8) + tmltrd(:,:,9) + tmltrd(:,:,10) 
    589          CALL histwrite( nidtrd,"somlgtat",it,z2d           ,ndimtrd1,ndextrd1) ! total adv. (eiv) 
    590 #endif    
    591  
    592          ! Salinity trends 
    593          ! --------------- 
    594          CALL histwrite( nidtrd,"somlsalt",it,sml           ,ndimtrd1,ndextrd1) ! Mixed-layer salinity 
    595          CALL histwrite( nidtrd,"somltsto",it,zsmltot       ,ndimtrd1,ndextrd1) ! total  
    596          CALL histwrite( nidtrd,"somltsax",it,smltrd(:,:, 1),ndimtrd1,ndextrd1) ! i- adv. 
    597          CALL histwrite( nidtrd,"somltsay",it,smltrd(:,:, 2),ndimtrd1,ndextrd1) ! j- adv. 
    598          CALL histwrite( nidtrd,"somltsaz",it,smltrd(:,:, 3),ndimtrd1,ndextrd1) ! vert. adv. 
    599          CALL histwrite( nidtrd,"somltsdh",it,smltrd(:,:, 4),ndimtrd1,ndextrd1) ! hor. lateral diff. 
    600          CALL histwrite( nidtrd,"somltsfo",it,smltrd(:,:, 5),ndimtrd1,ndextrd1) ! forcing 
    601          CALL histwrite( nidtrd,"somlbsdz",it,smltrd(:,:, 6),ndimtrd1,ndextrd1) ! vert. diff. 
    602          CALL histwrite( nidtrd,"somlbsdt",it,zsmlres       ,ndimtrd1,ndextrd1) ! dh/dt entrainment (residual) 
    603          IF( ln_traldf_iso ) THEN 
    604             CALL histwrite( nidtrd,"somlbsdv",it,smltrd(:,:, 7),ndimtrd1,ndextrd1) ! vert. lateral diff; 
    605          ENDIF 
    606 #if defined key_traldf_eiv 
    607          CALL histwrite( nidtrd,"somlgsax",it,smltrd(:,:, 8),ndimtrd1,ndextrd1) ! i-adv. (eiv) 
    608          CALL histwrite( nidtrd,"somlgsay",it,smltrd(:,:, 9),ndimtrd1,ndextrd1) ! j-adv. (eiv) 
    609          CALL histwrite( nidtrd,"somlgsaz",it,smltrd(:,:,10),ndimtrd1,ndextrd1) ! vert. adv. (eiv) 
    610          z2d(:,:) = smltrd(:,:,8) + smltrd(:,:,9) + smltrd(:,:,10) 
    611          CALL histwrite( nidtrd,"somlgsat",it,z2d           ,ndimtrd1,ndextrd1) ! total adv. (eiv) 
     587       
     588      ! IV.2 Code for IOIPSL/NetCDF output 
     589      ! ---------------------------------- 
     590 
     591      IF( lwp .AND. MOD( kt , ntrd ) == 0 ) THEN 
     592         WRITE(numout,*) ' ' 
     593         WRITE(numout,*) 'trd_mld : write trends in the NetCDF file :' 
     594         WRITE(numout,*) '~~~~~~~  ' 
     595         WRITE(numout,*) '          ', TRIM(clhstnam), ' at kt = ', kt 
     596         WRITE(numout,*) '          N.B. nmoymltrd = ', nmoymltrd 
     597         WRITE(numout,*) ' ' 
     598      END IF 
     599          
     600      it = kt - nit000 + 1 
     601 
     602      !-- Write the trends for T/S instantaneous diagnostics  
     603      IF( ln_trdmld_instant ) THEN            
     604 
     605         CALL histwrite( nidtrd, "mxl_depth", it, rmld(:,:), ndimtrd1, ndextrd1 ) 
     606          
     607         !................................. ( ML temperature ) ................................... 
     608          
     609         !-- Output the fields 
     610         CALL histwrite( nidtrd, "tml"     , it, tml    (:,:), ndimtrd1, ndextrd1 )  
     611         CALL histwrite( nidtrd, "tml_tot" , it, ztmltot(:,:), ndimtrd1, ndextrd1 )  
     612         CALL histwrite( nidtrd, "tml_res" , it, ztmlres(:,:), ndimtrd1, ndextrd1 )  
     613          
     614         DO jl = 1, jpltrd - 1 
     615            CALL histwrite( nidtrd, trim("tml"//ctrd(jl,2)),            & 
     616                 &          it, tmltrd (:,:,jl), ndimtrd1, ndextrd1 ) 
     617         END DO 
     618          
     619         CALL histwrite( nidtrd, trim("tml"//ctrd(jpmld_atf,2)),        & 
     620              &          it, ztmlatf(:,:), ndimtrd1, ndextrd1 ) 
     621          
     622         !.................................. ( ML salinity ) ..................................... 
     623          
     624         !-- Output the fields 
     625         CALL histwrite( nidtrd, "sml"     , it, sml    (:,:), ndimtrd1, ndextrd1 )  
     626         CALL histwrite( nidtrd, "sml_tot" , it, zsmltot(:,:), ndimtrd1, ndextrd1 )  
     627         CALL histwrite( nidtrd, "sml_res" , it, zsmlres(:,:), ndimtrd1, ndextrd1 )  
     628          
     629         DO jl = 1, jpltrd - 1 
     630            CALL histwrite( nidtrd, trim("sml"//ctrd(jl,2)),            & 
     631                 &          it, smltrd(:,:,jl), ndimtrd1, ndextrd1 ) 
     632         END DO 
     633          
     634         CALL histwrite( nidtrd, trim("sml"//ctrd(jpmld_atf,2)),        & 
     635              &          it, zsmlatf(:,:), ndimtrd1, ndextrd1 ) 
     636          
     637         IF( kt == nitend )   CALL histclo( nidtrd ) 
     638 
     639      !-- Write the trends for T/S mean diagnostics  
     640      ELSE 
     641          
     642         CALL histwrite( nidtrd, "mxl_depth", it, rmld_sum(:,:), ndimtrd1, ndextrd1 )  
     643          
     644         !................................. ( ML temperature ) ................................... 
     645          
     646         !-- Output the fields 
     647         CALL histwrite( nidtrd, "tml"     , it, tml_sum (:,:), ndimtrd1, ndextrd1 )  
     648         CALL histwrite( nidtrd, "tml_tot" , it, ztmltot2(:,:), ndimtrd1, ndextrd1 )  
     649         CALL histwrite( nidtrd, "tml_res" , it, ztmlres2(:,:), ndimtrd1, ndextrd1 )  
     650          
     651         DO jl = 1, jpltrd - 1 
     652            CALL histwrite( nidtrd, trim("tml"//ctrd(jl,2)),            & 
     653                 &          it, ztmltrd2(:,:,jl), ndimtrd1, ndextrd1 ) 
     654         END DO 
     655          
     656         CALL histwrite( nidtrd, trim("tml"//ctrd(jpmld_atf,2)),        & 
     657              &          it, ztmlatf2(:,:), ndimtrd1, ndextrd1 ) 
     658          
     659         !.................................. ( ML salinity ) ..................................... 
     660                      
     661         !-- Output the fields 
     662         CALL histwrite( nidtrd, "sml"     , it, sml_sum (:,:), ndimtrd1, ndextrd1 )  
     663         CALL histwrite( nidtrd, "sml_tot" , it, zsmltot2(:,:), ndimtrd1, ndextrd1 )  
     664         CALL histwrite( nidtrd, "sml_res" , it, zsmlres2(:,:), ndimtrd1, ndextrd1 )  
     665          
     666         DO jl = 1, jpltrd - 1 
     667            CALL histwrite( nidtrd, trim("sml"//ctrd(jl,2)),            & 
     668                 &          it, zsmltrd2(:,:,jl), ndimtrd1, ndextrd1 ) 
     669         END DO 
     670          
     671         CALL histwrite( nidtrd, trim("sml"//ctrd(jpmld_atf,2)),        & 
     672              &          it, zsmlatf2(:,:), ndimtrd1, ndextrd1 ) 
     673          
     674         IF( kt == nitend )   CALL histclo( nidtrd ) 
     675 
     676      END IF 
     677       
     678      ! Compute the control surface (for next time step) : flag = on 
     679      icount = 1 
     680      ! 
    612681#endif 
    613682 
    614          IF( idebug /= 0 ) THEN 
    615             WRITE(numout,*) ' debuging trd_mld: III.5 done'   
    616             CALL FLUSH(numout) 
    617          ENDIF 
    618  
    619          ! set counter icount to one to allow the calculation 
    620          ! of the surface control in the next time step in the trd_mld_zint subroutine 
    621          icount = 1 
    622  
    623       ENDIF 
    624  
    625       ! At the end of the 1st time step, set icount to 1 to be 
    626       ! able to compute the surface control at the beginning of 
    627       ! the second time step 
    628       IF( kt == nit000 )   icount = 1 
    629  
    630       IF( kt == nitend )   CALL histclo( nidtrd ) 
    631 #endif 
     683      IF( MOD( kt , ntrd ) == 0 ) THEN 
     684         ! 
     685         ! III.5 Reset cumulative arrays to zero 
     686         ! ------------------------------------- 
     687         nmoymltrd = 0 
     688          
     689         !   ... temperature ...               ... salinity ... 
     690         tmltrdm        (:,:)   = 0.e0   ;   smltrdm        (:,:)   = 0.e0 
     691         tmlatfm        (:,:)   = 0.e0   ;   smlatfm        (:,:)   = 0.e0 
     692         tml_sum        (:,:)   = 0.e0   ;   sml_sum        (:,:)   = 0.e0 
     693         tmltrd_csum_ln (:,:,:) = 0.e0   ;   smltrd_csum_ln (:,:,:) = 0.e0 
     694         tmltrd_sum     (:,:,:) = 0.e0   ;   smltrd_sum     (:,:,:) = 0.e0 
     695 
     696         rmld_sum       (:,:)   = 0.e0 
     697         ! 
     698      END IF 
    632699 
    633700   END SUBROUTINE trd_mld 
    … …  
    642709      !!      from ocean surface down to control surface (NetCDF output) 
    643710      !! 
    644       !! ** Method/usage : 
    645       !! 
    646       !! History : 
    647       !!        !  95-04  (J. Vialard)  Original code 
    648       !!        !  97-02  (E. Guilyardi)  Adaptation global + base cmo 
    649       !!        !  99-09  (E. Guilyardi)  Re-writing + netCDF output 
    650       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    651       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    652711      !!---------------------------------------------------------------------- 
    653712      !! * Local declarations 
    654       INTEGER :: ilseq 
     713      INTEGER :: ilseq, jl 
    655714 
    656715      REAL(wp) ::   zjulian, zsto, zout 
    657716 
    658       CHARACTER (LEN=21) ::   & 
     717      CHARACTER (LEN=21) ::    & 
    659718         clold ='OLD'        , & ! open specifier (direct access files) 
    660719         clunf ='UNFORMATTED', & ! open specifier (direct access files) 
    661720         clseq ='SEQUENTIAL'     ! open specifier (direct access files) 
    662       CHARACTER (LEN=40) ::   clhstnam 
    663721      CHARACTER (LEN=40) ::   clop 
    664       CHARACTER (LEN=12) ::   clmxl 
    665  
    666       NAMELIST/namtrd/ ntrd, nctls 
     722      CHARACTER (LEN=12) ::   clmxl, cltu, clsu 
     723 
    667724      !!---------------------------------------------------------------------- 
    668725 
    669       !  =================== 
    670       !   I. initialization 
    671       !  =================== 
    672  
    673       ! Open specifier 
    674       ilseq  = 1 
    675       idebug = 0      ! set it to 1 in case of problem to have more print 
    676       icount = 1       
    677       ionce  = 1 
    678  
    679       ! namelist namtrd : trend diagnostic 
    680       REWIND( numnam ) 
    681       READ  ( numnam, namtrd ) 
     726      ! ====================================================================== 
     727      ! I. initialization 
     728      ! ====================================================================== 
    682729 
    683730      IF(lwp) THEN 
    684          WRITE(numout,*) ' ' 
    685          WRITE(numout,*) 'trd_mld_init: mixed layer heat & freshwater budget trends' 
    686          WRITE(numout,*) '~~~~~~~~~~~~~' 
    687          WRITE(numout,*) ' ' 
    688          WRITE(numout,*) '          Namelist namtrd : ' 
    689          WRITE(numout,*) '             control surface for trends      nctls = ',nctls 
    690          WRITE(numout,*) ' ' 
    691       ENDIF 
    692  
    693       ! cumulated trends array init 
     731         WRITE(numout,*) 
     732         WRITE(numout,*) ' trd_mld_init : Mixed-layer trends' 
     733         WRITE(numout,*) ' ~~~~~~~~~~~~~' 
     734         WRITE(numout,*) '                namelist namtrd read in trd_mod_init                        ' 
     735         WRITE(numout,*) 
     736      END IF 
     737 
     738      ! I.1 Check consistency of user defined preferences 
     739      ! ------------------------------------------------- 
     740 
     741      IF( ( lk_trdmld ) .AND. ( MOD( nitend, ntrd ) /= 0 ) ) THEN 
     742         WRITE(numout,cform_err) 
     743         WRITE(numout,*) '                Your nitend parameter, nitend = ', nitend 
     744         WRITE(numout,*) '                is no multiple of the trends diagnostics frequency        ' 
     745         WRITE(numout,*) '                          you defined, ntrd   = ', ntrd 
     746         WRITE(numout,*) '                This will not allow you to restart from this simulation.  ' 
     747         WRITE(numout,*) '                You should reconsider this choice.                        '  
     748         WRITE(numout,*)  
     749         WRITE(numout,*) '                N.B. the nitend parameter is also constrained to be a     ' 
     750         WRITE(numout,*) '                multiple of the sea-ice frequency parameter (typically 5) ' 
     751         nstop = nstop + 1 
     752      END IF 
     753 
     754      IF( ( lk_trdmld ) .AND. ( n_cla == 1 ) ) THEN 
     755         WRITE(numout,cform_war) 
     756         WRITE(numout,*) '                You set n_cla = 1. Note that the Mixed-Layer diagnostics  ' 
     757         WRITE(numout,*) '                are not exact along the corresponding straits.            ' 
     758         nwarn = nwarn + 1 
     759      END IF 
     760 
     761      ! I.2 Initialize arrays to zero or read a restart file 
     762      ! ---------------------------------------------------- 
     763 
    694764      nmoymltrd = 0 
    695       tmltrdm(:,:) = 0.e0 
    696       smltrdm(:,:) = 0.e0 
    697  
    698       !  read control surface from file ctlsurf_idx 
    699  
     765 
     766      !     ... temperature ...                  ... salinity ... 
     767      tml            (:,:)   = 0.e0    ;    sml            (:,:)   = 0.e0     ! inst. 
     768      tmltrdm        (:,:)   = 0.e0    ;    smltrdm        (:,:)   = 0.e0 
     769      tmlatfm        (:,:)   = 0.e0    ;    smlatfm        (:,:)   = 0.e0 
     770      tml_sum        (:,:)   = 0.e0    ;    sml_sum        (:,:)   = 0.e0     ! mean 
     771      tmltrd_sum     (:,:,:) = 0.e0    ;    smltrd_sum     (:,:,:) = 0.e0 
     772      tmltrd_csum_ln (:,:,:) = 0.e0    ;    smltrd_csum_ln (:,:,:) = 0.e0 
     773 
     774      rmld           (:,:)   = 0.e0             
     775      rmld_sum       (:,:)   = 0.e0 
     776 
     777      IF( ln_rstart .AND. ln_trdmld_restart ) THEN 
     778         CALL trd_mld_rst_read 
     779      ELSE 
     780         !     ... temperature ...                  ... salinity ... 
     781         tmlb           (:,:)   = 0.e0    ;    smlb           (:,:)   = 0.e0  ! inst. 
     782         tmlbb          (:,:)   = 0.e0    ;    smlbb          (:,:)   = 0.e0   
     783         tmlbn          (:,:)   = 0.e0    ;    smlbn          (:,:)   = 0.e0   
     784         tml_sumb       (:,:)   = 0.e0    ;    sml_sumb       (:,:)   = 0.e0  ! mean 
     785         tmltrd_csum_ub (:,:,:) = 0.e0    ;    smltrd_csum_ub (:,:,:) = 0.e0 
     786         tmltrd_atf_sumb(:,:)   = 0.e0    ;    smltrd_atf_sumb(:,:)   = 0.e0   
     787      END IF 
     788 
     789      ilseq  = 1   ;   icount = 1   ;   ionce  = 1                            ! open specifier 
     790 
     791      ! I.3 Read control surface from file ctlsurf_idx 
     792      ! ---------------------------------------------- 
     793  
    700794      IF( nctls == 1 ) THEN 
    701          clname ='ctlsurf_idx' 
    702          CALL ctlopn(numbol,clname,clold,clunf,clseq,   & 
    703               ilseq,numout,lwp,1) 
    704          REWIND (numbol) 
    705          READ(numbol) nbol 
    706       ENDIF 
    707  
    708  
    709       IF( idebug /= 0 ) THEN 
    710          WRITE(numout,*) ' debuging trd_mld_init: 0. done '   
    711          CALL FLUSH(numout) 
    712       ENDIF 
    713  
    714       !  =================================== 
    715       !   II. netCDF output initialization 
    716       !  =================================== 
     795         clname = 'ctlsurf_idx' 
     796         CALL ctlopn( numbol, clname, clold, clunf, clseq, ilseq, numout, lwp, 1 ) 
     797         REWIND( numbol ) 
     798         READ  ( numbol ) nbol 
     799      END IF 
     800 
     801      ! ====================================================================== 
     802      ! II. netCDF output initialization 
     803      ! ====================================================================== 
    717804 
    718805#if defined key_dimgout  
    719  
     806      ??? 
    720807#else 
    721       !     clmxl = legend root for netCDF output 
    722       IF( nctls == 0 ) THEN 
    723          ! control surface = mixed-layer with density criterion  
    724          ! (array nmln computed in zdfmxl.F90) 
    725          clmxl = 'Mixed Layer ' 
    726       ELSE IF( nctls == 1 ) THEN 
    727          ! control surface = read index from file  
     808      ! clmxl = legend root for netCDF output 
     809      IF( nctls == 0 ) THEN      ! control surface = mixed-layer with density criterion 
     810         clmxl = 'Mixed Layer '  !                   (array nmln computed in zdfmxl.F90) 
     811      ELSE IF( nctls == 1 ) THEN ! control surface = read index from file  
    728812         clmxl = '      Bowl ' 
    729       ELSE IF( nctls >= 2 ) THEN 
    730          ! control surface = model level 
    731          WRITE(clmxl,'(A9,I2,1X)') 'Levels 1-', nctls 
    732       ENDIF 
    733  
    734       !----------------------------------------- 
     813      ELSE IF( nctls >= 2 ) THEN ! control surface = model level 
     814         WRITE(clmxl,'(A10,I2,1X)') 'Levels 1 -', nctls 
     815      END IF 
     816 
    735817      ! II.1 Define frequency of output and means 
    736818      ! ----------------------------------------- 
    737  
    738 #if defined key_diainstant 
    739       zsto = nwrite*rdt 
    740       clop ="inst(x)" 
    741 #else 
    742       zsto = rdt 
    743       clop ="ave(x)" 
    744 #endif 
    745       zout = nwrite*rdt 
    746  
    747       IF(lwp) WRITE (numout,*) ' trdmld_ncinit: netCDF initialization' 
     819#  if defined key_diainstant 
     820      IF( .NOT. ln_trdmld_instant ) THEN 
     821         CALL ctl_stop( 'trd_mld : this was never checked. Comment this line to proceed...' ) 
     822      END IF 
     823      zsto = ntrd * rdt 
     824      clop ="inst(only(x))" 
     825#  else 
     826      IF( ln_trdmld_instant ) THEN 
     827         zsto = rdt                 ! inst. diags : we use IOIPSL time averaging 
     828      ELSE 
     829         zsto = ntrd * rdt          ! mean  diags : we DO NOT use any IOIPSL time averaging 
     830      END IF 
     831      clop ="ave(only(x))" 
     832#  endif 
     833      zout = ntrd * rdt 
     834 
     835      IF(lwp) WRITE (numout,*) '                netCDF initialization' 
    748836 
    749837      ! II.2 Compute julian date from starting date of the run 
    750       ! ------------------------ 
    751  
     838      ! ------------------------------------------------------ 
    752839      CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian ) 
    753       IF (lwp) WRITE(numout,*)' '   
    754       IF (lwp) WRITE(numout,*)' Date 0 used :',nit000   & 
    755            ,' YEAR ', nyear,' MONTH ', nmonth,' DAY ', nday   & 
    756            ,'Julian day : ', zjulian 
     840      IF(lwp) WRITE(numout,*)' '   
     841      IF(lwp) WRITE(numout,*)'                Date 0 used :',nit000,    & 
     842         &                   ' YEAR ', nyear,' MONTH '      , nmonth,   & 
     843         &                   ' DAY ' , nday, 'Julian day : ', zjulian 
    757844 
    758845 
    759846      ! II.3 Define the T grid trend file (nidtrd) 
    760       ! --------------------------------- 
    761  
    762       CALL dia_nam( clhstnam, nwrite, 'trends' )                  ! filename 
     847      ! ------------------------------------------ 
     848      !-- Define long and short names for the NetCDF output variables 
     849      !       ==> choose them according to trdmld_oce.F90 <== 
     850 
     851      ctrd(jpmld_xad,1) = " Zonal advection"                  ;   ctrd(jpmld_xad,2) = "_xad" 
     852      ctrd(jpmld_yad,1) = " Meridional advection"             ;   ctrd(jpmld_yad,2) = "_yad" 
     853      ctrd(jpmld_zad,1) = " Vertical advection"               ;   ctrd(jpmld_zad,2) = "_zad" 
     854      ctrd(jpmld_ldf,1) = " Lateral diffusion"                ;   ctrd(jpmld_ldf,2) = "_ldf" 
     855      ctrd(jpmld_for,1) = " Forcing"                          ;   ctrd(jpmld_for,2) = "_for" 
     856      ctrd(jpmld_zdf,1) = " Vertical diff. (Kz)"              ;   ctrd(jpmld_zdf,2) = "_zdf" 
     857      ctrd(jpmld_bbc,1) = " Geothermal flux"                  ;   ctrd(jpmld_bbc,2) = "_bbc" 
     858      ctrd(jpmld_bbl,1) = " Adv/diff. Bottom boundary layer"  ;   ctrd(jpmld_bbl,2) = "_bbl" 
     859      ctrd(jpmld_dmp,1) = " Tracer damping"                   ;   ctrd(jpmld_dmp,2) = "_dmp" 
     860      ctrd(jpmld_npc,1) = " Non penetrative convec. adjust."  ;   ctrd(jpmld_npc,2) = "_npc" 
     861      ctrd(jpmld_atf,1) = " Asselin time filter"              ;   ctrd(jpmld_atf,2) = "_atf" 
     862                                                                   
     863      !-- Create a NetCDF file and enter the define mode  
     864      CALL dia_nam( clhstnam, ntrd, 'trends' ) 
    763865      IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 
    764       CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,1, jpi,   &  ! Horizontal grid : glamt and gphit 
    765          &          1, jpj, 0, zjulian, rdt, nh_t, nidtrd, domain_id=nidom ) 
    766  
    767       ! Declare output fields as netCDF variables 
    768  
    769       ! Mixed layer Depth 
    770       CALL histdef( nidtrd, "somlttml", clmxl//"Depth"              , "m"   ,   &  ! hmlp 
    771          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    772  
    773       ! Temperature 
    774       CALL histdef( nidtrd, "somltemp", clmxl//"Temperature"        , "C"   ,   &  ! ??? 
    775          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    776       ! Temperature trends 
    777       CALL histdef( nidtrd, "somlttto", clmxl//"T Total"             , "C/s",   &  ! total 
    778          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout ) 
    779       CALL histdef( nidtrd, "somlttax", clmxl//"T Zonal Advection", "C/s",       & ! i-adv. 
    780          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    781       CALL histdef( nidtrd, "somlttay", clmxl//"T Meridional Advection", "C/s",   & ! j-adv. 
    782          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    783       CALL histdef( nidtrd, "somlttaz", clmxl//"T Vertical Advection", "C/s",   & ! vert. adv. 
    784          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    785       CALL histdef( nidtrd, "somlttdh", clmxl//"T Horizontal Diffusion ", "C/s",   & ! hor. lateral diff. 
    786          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    787       CALL histdef( nidtrd, "somlttfo", clmxl//"T Forcing", "C/s",   & ! forcing 
    788          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    789       CALL histdef( nidtrd, "somlbtdz", clmxl//"T Vertical Diffusion", "C/s",   & ! vert. diff. 
    790          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    791       CALL histdef( nidtrd, "somlbtdt", clmxl//"T dh/dt Entrainment (Residual)", "C/s",   & ! T * dh/dt  
    792          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout ) 
    793       IF( ln_traldf_iso ) THEN 
    794       CALL histdef( nidtrd, "somlbtdv", clmxl//"T Vert. lateral Diffusion","C/s",   & ! vertical diffusion entrainment (ISO) 
    795          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    796       ENDIF 
    797 #if defined key_traldf_eiv 
    798       CALL histdef( nidtrd, "somlgtax", clmxl//"T Zonal EIV Advection", "C/s",   & ! i-adv. (eiv) 
    799          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    800       CALL histdef( nidtrd, "somlgtay", clmxl//"T Meridional EIV Advection", "C/s",   & ! j-adv. (eiv) 
    801          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    802       CALL histdef( nidtrd, "somlgtaz", clmxl//"T Vertical EIV Advection", "C/s",   & ! vert. adv. (eiv) 
    803          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    804       CALL histdef( nidtrd, "somlgtat", clmxl//"T Total EIV Advection", "C/s",   & ! total advection (eiv) 
    805          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    806 #endif 
    807       ! Salinity 
    808       CALL histdef( nidtrd, "somlsalt", clmxl//"Salinity", "PSU",   & ! Mixed-layer salinity 
    809          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    810       ! Salinity trends 
    811       CALL histdef( nidtrd, "somltsto", clmxl//"S Total", "PSU/s",   & ! total  
    812          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    813       CALL histdef( nidtrd, "somltsax", clmxl//"S Zonal Advection", "PSU/s",   & ! i-advection 
    814          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    815       CALL histdef( nidtrd, "somltsay", clmxl//"S Meridional Advection", "PSU/s",   & ! j-advection 
    816          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    817       CALL histdef( nidtrd, "somltsaz", clmxl//"S Vertical Advection", "PSU/s",   & ! vertical advection 
    818          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    819       CALL histdef( nidtrd, "somltsdh", clmxl//"S Horizontal Diffusion ", "PSU/s",   & ! hor. lat. diff. 
    820          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    821       CALL histdef( nidtrd, "somltsfo", clmxl//"S Forcing", "PSU/s",   & ! forcing 
    822          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    823  
    824       CALL histdef( nidtrd, "somlbsdz", clmxl//"S Vertical Diffusion", "PSU/s",   & ! vert. diff. 
    825          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    826       CALL histdef( nidtrd, "somlbsdt", clmxl//"S dh/dt Entrainment (Residual)", "PSU/s",   & ! S * dh/dt  
    827          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    828       IF( ln_traldf_iso ) THEN 
    829       ! vertical diffusion entrainment (ISO) 
    830       CALL histdef( nidtrd, "somlbsdv", clmxl//"S Vertical lateral Diffusion", "PSU/s",   & ! vert. lat. diff. 
    831          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    832       ENDIF 
    833 #if defined key_traldf_eiv 
    834       CALL histdef( nidtrd, "somlgsax", clmxl//"S Zonal EIV Advection", "PSU/s",   & ! i-advection (eiv) 
    835          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    836       CALL histdef( nidtrd, "somlgsay", clmxl//"S Meridional EIV Advection", "PSU/s",   & ! j-advection (eiv) 
    837          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    838       CALL histdef( nidtrd, "somlgsaz", clmxl//"S Vertical EIV Advection", "PSU/s",   & ! vert. adv. (eiv) 
    839          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    840       CALL histdef( nidtrd, "somlgsat", clmxl//"S Total EIV Advection", "PSU/s",   & ! total adv. (eiv) 
    841          &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    842 #endif 
     866      CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
     867      &             1, jpi, 1, jpj, 0, zjulian, rdt, nh_t, nidtrd, domain_id=nidom ) 
     868 
     869      !-- Define the ML depth variable 
     870      CALL histdef(nidtrd, "mxl_depth", clmxl//"  Mixed Layer Depth"              , "m",         & 
     871                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     872 
     873      !-- Define physical units 
     874      IF( ucf == 1. ) THEN 
     875         cltu = "degC/s"     ;   clsu = "p.s.u./s" 
     876      ELSEIF ( ucf == 3600.*24.) THEN 
     877         cltu = "degC/day"   ;   clsu = "p.s.u./day" 
     878      ELSE 
     879         cltu = "unknown?"   ;   clsu = "unknown?" 
     880      END IF 
     881 
     882      !-- Define miscellaneous T and S mixed-layer variables  
     883 
     884      IF( jpltrd /= jpmld_atf ) CALL ctl_stop( 'Error : jpltrd /= jpmld_atf' ) ! see below 
     885 
     886      !................................. ( ML temperature ) ................................... 
     887 
     888      CALL histdef(nidtrd, "tml"      , clmxl//" T Mixed Layer Temperature"       ,  "C",        & 
     889                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )            
     890      CALL histdef(nidtrd, "tml_tot",   clmxl//" T Total trend"                   , cltu,        &  
     891                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout )               
     892      CALL histdef(nidtrd, "tml_res",   clmxl//" T dh/dt Entrainment (Resid.)"    , cltu,        &  
     893                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout )                    
     894       
     895      DO jl = 1, jpltrd - 1      ! <== only true if jpltrd == jpmld_atf 
     896         CALL histdef(nidtrd, trim("tml"//ctrd(jl,2)), clmxl//" T"//ctrd(jl,1), cltu,            &  
     897                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean 
     898      END DO                                                                 ! if zsto=rdt above 
     899       
     900      CALL histdef(nidtrd, trim("tml"//ctrd(jpmld_atf,2)), clmxl//" T"//ctrd(jpmld_atf,1), cltu, &  
     901                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout ) ! IOIPSL: NO time mean 
     902       
     903      !.................................. ( ML salinity ) ..................................... 
     904      
     905      CALL histdef(nidtrd, "sml"      , clmxl//" S Mixed Layer Salinity"          , "p.s.u.",       & 
     906                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )            
     907      CALL histdef(nidtrd, "sml_tot",   clmxl//" S Total trend"                   , clsu,        &  
     908                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout )               
     909      CALL histdef(nidtrd, "sml_res",   clmxl//" S dh/dt Entrainment (Resid.)"    , clsu,        &  
     910                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout )                    
     911       
     912      DO jl = 1, jpltrd - 1      ! <== only true if jpltrd == jpmld_atf 
     913         CALL histdef(nidtrd, trim("sml"//ctrd(jl,2)), clmxl//" S"//ctrd(jl,1), clsu,            &  
     914                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean 
     915      END DO                                                                 ! if zsto=rdt above 
     916       
     917      CALL histdef(nidtrd, trim("sml"//ctrd(jpmld_atf,2)), clmxl//" S"//ctrd(jpmld_atf,1), clsu, &  
     918                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout ) ! IOIPSL: NO time mean 
     919 
     920      !-- Leave IOIPSL/NetCDF define mode 
    843921      CALL histend( nidtrd ) 
    844 #endif 
    845  
    846       IF( idebug /= 0 ) THEN 
    847          WRITE(numout,*) ' debuging trd_mld_init: II. done'   
    848          CALL FLUSH(numout) 
    849       ENDIF 
    850  
    851  
    852       END SUBROUTINE trd_mld_init 
     922 
     923#endif        /* key_dimgout */ 
     924   END SUBROUTINE trd_mld_init 
    853925 
    854926#else 
    … …  
    856928   !!   Default option :                                       Empty module 
    857929   !!---------------------------------------------------------------------- 
    858    LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .FALSE.   !: momentum trend flag 
    859930CONTAINS 
    860931   SUBROUTINE trd_mld( kt )             ! Empty routine 

  • trunk/NEMO/OPA_SRC/TRD/trdmld_oce.F90

    r247 r503  
    44   !! Ocean trends :   set tracer and momentum trend variables 
    55   !!====================================================================== 
     6   !! History :  9.0  !  04-08  (C. Talandier)  New trends organization 
    67   !!---------------------------------------------------------------------- 
    7    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    8    !! $Header$  
    9    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    10    !!---------------------------------------------------------------------- 
    11    !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    138   USE par_oce         ! ocean parameters 
    149 
    1510   IMPLICIT NONE 
    16    PUBLIC 
     11   PRIVATE 
    1712 
    18    INTEGER, PARAMETER ::            &  !: mixed layer trends index 
    19       jpmldxad = 1,   &  !: zonal advection 
    20       jpmldyad = 2,   &  !: meridionnal advection 
    21       jpmldzad = 3,   &  !: vertical advection 
    22       jpmldldf = 4,   &  !: lateral diffusion (horiz. component+Beckman) 
    23       jpmldfor = 5,   &  !: forcing  
    24       jpmldevd = 6,   &  !: entrainment due to vertical diffusion (TKE) 
    25       jpmldzdf = 7,   &  !: explicit vertical part if isopycnal diffusion 
    26       jpmldxei = 8,   &  !: eddy induced zonal advection 
    27       jpmldyei = 9,   &  !: eddy induced meridional advection 
    28       jpmldzei =10       !: eddy induced vertical advection 
     13#if defined key_trdmld 
     14   LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .TRUE.    !: ML trend flag 
     15#else 
     16   LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .FALSE.   !: ML trend flag 
     17#endif 
     18   !!* mixed layer trends indices 
     19   INTEGER, PARAMETER, PUBLIC ::   jpltrd = 11    !: number of mixed-layer trends arrays 
     20   INTEGER, PARAMETER, PUBLIC ::   jpktrd = jpk   !: max level for mixed-layer trends diag. 
     21   ! 
     22   INTEGER, PUBLIC, PARAMETER ::   jpmld_xad =  1   !:  zonal      \ 
     23   INTEGER, PUBLIC, PARAMETER ::   jpmld_yad =  2   !:  meridonal   > advection 
     24   INTEGER, PUBLIC, PARAMETER ::   jpmld_zad =  3   !:  vertical   / 
     25   INTEGER, PUBLIC, PARAMETER ::   jpmld_ldf =  4   !:  lateral diffusion (geopot. or iso-neutral) 
     26   INTEGER, PUBLIC, PARAMETER ::   jpmld_for =  5   !:  forcing  
     27   INTEGER, PUBLIC, PARAMETER ::   jpmld_zdf =  6   !:  vertical diffusion (TKE) 
     28   INTEGER, PUBLIC, PARAMETER ::   jpmld_bbc =  7   !:  geothermal flux 
     29   INTEGER, PUBLIC, PARAMETER ::   jpmld_bbl =  8   !:  bottom boundary layer (advective/diffusive) 
     30   INTEGER, PUBLIC, PARAMETER ::   jpmld_dmp =  9   !:  internal restoring trend 
     31   INTEGER, PUBLIC, PARAMETER ::   jpmld_npc = 10   !:  non penetrative convective adjustment 
     32   INTEGER, PUBLIC, PARAMETER ::   jpmld_atf = 11   !:  asselin trend 
     33!! INTEGER, PUBLIC, PARAMETER ::   jpmld_xxx = xx   !:  add here any additional trend (add change jpltrd) 
    2934 
    3035#if   defined  key_trdmld   ||   defined key_esopa 
    … …  
    3338   !!---------------------------------------------------------------------- 
    3439 
    35    !! Trends diagnostics parameters 
     40   !! Arrays used for diagnosing mixed-layer trends  
    3641   !!--------------------------------------------------------------------- 
    37    INTEGER, PARAMETER ::            &  !: 
    38 # if defined key_traldf_eiv 
    39       jpltrd = 10,  &  !: number of mixed-layer trends arrays 
    40       jpktrd = jpk     !: max level for mixed-layer trends diag. 
    41 # else 
    42       jpltrd = 7,   &  !: number of mixed-layer trends arrays 
    43       jpktrd = jpk     !: max level for mixed-layer trends diag. 
    44 # endif 
     42   CHARACTER(LEN=80) , PUBLIC :: clname, ctrd(jpltrd+1,2) 
    4543 
     44   INTEGER , PUBLIC, DIMENSION(jpi,jpj)     ::   nmld   !: mixed layer depth indexes  
     45   INTEGER , PUBLIC, DIMENSION(jpi,jpj)     ::   nbol   !: mixed-layer depth indexes when read from file 
     46 
     47   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   wkx    !: 
     48 
     49   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  & 
     50      rmld   ,                      & !: mld depth (m) corresponding to nmld 
     51      tml    , sml  ,               & !: \ "now" mixed layer temperature/salinity 
     52      tmlb   , smlb ,               & !: /  and associated "before" fields 
     53      tmlbb  , smlbb,               & !: \  idem, but valid at the 1rst time step of the 
     54      tmlbn  , smlbn,               & !: /  current analysis window 
     55      tmltrdm, smltrdm,             & !: total cumulative trends over the analysis window 
     56      tml_sum,                      & !: mixed layer T, summed over the current analysis period 
     57      tml_sumb,                     & !: idem, but from the previous analysis period 
     58      tmltrd_atf_sumb,              & !: Asselin trends, summed over the previous analysis period 
     59      sml_sum,                      & !:  
     60      sml_sumb,                     & !:    ( idem for salinity ) 
     61      smltrd_atf_sumb,              & !:  
     62      rmld_sum, rmldbn                !: needed to compute the leap-frog time mean of the ML depth 
     63 
     64   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  & 
     65      tmlatfb, tmlatfn ,            & !: "before" Asselin contribution at begining of the averaging 
     66      smlatfb, smlatfn,             & !: period (i.e. last contrib. from previous such period) and  
     67                                      !: "now" Asselin contribution to the ML temp. & salinity trends 
     68      tmlatfm, smlatfm                !: accumulator for Asselin trends (needed for storage only) 
     69 
     70   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpltrd) ::  & 
     71      tmltrd,                       & !: \ physical contributions to the total trend (for T/S), 
     72      smltrd,                       & !: / cumulated over the current analysis window 
     73      tmltrd_sum,                   & !: sum of these trends over the analysis period 
     74      tmltrd_csum_ln,               & !: now cumulated sum of the trends over the "lower triangle" 
     75      tmltrd_csum_ub,               & !: before (prev. analysis period) cumulated sum over the upper triangle 
     76      smltrd_sum,                   & !:  
     77      smltrd_csum_ln,               & !:    ( idem for salinity ) 
     78      smltrd_csum_ub                  !:  
    4679#endif 
    47   !!====================================================================== 
     80   !!---------------------------------------------------------------------- 
     81   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     82   !! $Header$  
     83   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     84   !!====================================================================== 
    4885END MODULE trdmld_oce 

  • trunk/NEMO/OPA_SRC/TRD/trdmod.F90

    r462 r503  
    44   !! Ocean diagnostics:  ocean tracers and dynamic trends 
    55   !!===================================================================== 
     6   !! History :  9.0  !  04-08  (C. Talandier) Original code 
     7   !!                 !  05-04  (C. Deltel)    Add Asselin trend in the ML budget 
     8   !!---------------------------------------------------------------------- 
    69#if  defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa 
    710   !!---------------------------------------------------------------------- 
    811   !!   trd_mod          : Call the trend to be computed 
    9    !!---------------------------------------------------------------------- 
    10    !! * Modules used 
     12   !!   trd_mod_init     : Initialization step 
     13   !!---------------------------------------------------------------------- 
     14   USE phycst                  ! physical constants 
    1115   USE oce                     ! ocean dynamics and tracers variables 
    1216   USE dom_oce                 ! ocean space and time domain variables 
     17   USE zdf_oce                 ! ocean vertical physics variables 
    1318   USE trdmod_oce              ! ocean variables trends 
     19   USE ldftra_oce              ! ocean active tracers lateral physics 
    1420   USE trdvor                  ! ocean vorticity trends  
    1521   USE trdicp                  ! ocean bassin integral constraints properties 
    1622   USE trdmld                  ! ocean active mixed layer tracers trends  
    17    USE trabbl                  ! bottom boundary layer variables 
    1823   USE in_out_manager          ! I/O manager 
     24   USE taumod                  ! surface ocean stress 
    1925 
    2026   IMPLICIT NONE 
    2127   PRIVATE 
    2228 
    23    !! * Routine accessibility 
    24    PUBLIC trd_mod        ! called by all dynXX or traXX modules 
     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 
    2533 
    2634   !! * Substitutions 
    … …  
    3038   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    3139   !! $Header$  
    32    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     40   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3341   !!---------------------------------------------------------------------- 
    3442 
    3543CONTAINS 
    3644 
    37    SUBROUTINE trd_mod(ptrdx, ptrdy, ktrd, ctype, kt) 
     45   SUBROUTINE trd_mod( ptrdx, ptrdy, ktrd, ctype, kt, cnbpas ) 
    3846      !!--------------------------------------------------------------------- 
    3947      !!                  ***  ROUTINE trd_mod  *** 
    4048      !!  
    4149      !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or  
    42       !!              integral constrains 
     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 
    4358      !! 
    44       !! ** Method : 
    45       !! 
    46       !! History : 
    47       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    48       !!---------------------------------------------------------------------- 
    49       !! * Modules used 
    50 #if defined key_trabbl_adv 
    51       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  &  ! temporary arrays 
    52          &         zun, zvn 
    53 #else 
    54       USE oce                , zun => un,  &  ! When no bbl, zun == un 
    55          &                     zvn => vn      ! When no bbl, zvn == vn 
    56 #endif 
    57  
    58       !! * Arguments 
    59       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
    60          ptrdx,                      &   ! Temperature or U trend  
    61          ptrdy                           ! Salinity    or V trend 
    62  
    63       INTEGER, INTENT( in ) ::   & 
    64          kt  ,                   & ! time step 
    65          ktrd                      ! tracer trend index 
    66  
    67       CHARACTER(len=3), INTENT( in ) ::   & 
    68          ctype                             ! momentum or tracers trends type 
    69          !                                 ! 'DYN' or 'TRA' 
    70  
    71       !! * Local save 
    72       REAL(wp), DIMENSION(jpi,jpj), SAVE ::   & 
    73          zbtr2 
    74  
    75       !! * Local declarations 
    76       INTEGER ::   ji, jj, jk    ! loop indices 
    77       REAL(wp) ::   & 
    78          zbtr,            &  ! temporary scalars 
    79          zfui, zfvj,           &  !    "         " 
    80          zfui1, zfvj1             !    "         " 
    81       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    82          z2dx, z2dy                        ! workspace arrays 
    83       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    84          z3dx, z3dy                            ! workspace arrays 
    85       !!---------------------------------------------------------------------- 
    86  
    87       ! Initialization of workspace arrays 
    88       z3dx(:,:,:) = 0.e0 
    89       z3dy(:,:,:) = 0.e0 
    90       z2dx(:,:) = 0.e0 
    91       z2dy(:,:) = 0.e0 
     59      INTEGER ::   ji, ikbu, ikbum1 
     60      INTEGER ::   jj, ikbv, ikbvm1 
     61      CHARACTER(len=3) ::   clpas                                  ! 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      clpas = 'fst' 
     72      IF( PRESENT(cnbpas) )  clpas = 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 
    9277 
    9378      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    94       ! I. Bassin averaged properties for momentum and/or tracers trends 
     79      ! I. Integral Constraints Properties for momentum and/or tracers trends 
    9580      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    9681 
    9782      IF( ( mod(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend) )   THEN 
    98  
    99          ! Active tracers trends  
    100          IF( lk_trdtra .AND. ctype == 'TRA' )   THEN 
    101  
    102             IF( ktrd == jpttdnsr )   THEN 
    103                ! 2D array tracers surface forcing 
    104                z2dx(:,:) = ptrdx(:,:,1) 
    105                z2dy(:,:) = ptrdy(:,:,1) 
    106  
    107                CALL trd(z2dx, z2dy, ktrd, ctype) 
    108             ELSE 
    109                ! 3D array 
    110                CALL trd(ptrdx, ptrdy, ktrd, ctype) 
    111             ENDIF 
    112  
    113          ENDIF 
    114  
    115          ! Momentum trends  
    116          IF( lk_trddyn .AND. ctype == 'DYN' )   THEN 
    117  
    118             IF( ktrd == jpdtdswf .OR. ktrd == jpdtdbfr )   THEN 
    119                ! momentum surface forcing/bottom friction  2D array 
    120                z2dx(:,:) = ptrdx(:,:,1) 
    121                z2dy(:,:) = ptrdy(:,:,1) 
    122  
    123                CALL trd(z2dx, z2dy, ktrd, ctype) 
    124             ELSE 
    125                ! 3D array 
    126                CALL trd(ptrdx, ptrdy, ktrd, ctype) 
    127             ENDIF 
    128  
    129          ENDIF 
    130  
    131       ENDIF 
     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 )    
     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 
    132153 
    133154      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    136157 
    137158      IF( lk_trdvor .AND. ctype == 'DYN' )   THEN 
    138  
    139          SELECT CASE ( ktrd ) 
    140  
    141          ! Pressure Gradient trend 
    142          CASE ( jpdtdhpg )       
    143             CALL trd_vor_zint(ptrdx, ptrdy, jpvorprg) 
    144  
    145          ! KE Gradient trend 
    146          CASE ( jpdtdkeg )       
    147             CALL trd_vor_zint(ptrdx, ptrdy, jpvorkeg) 
    148  
    149          ! Relative Vorticity trend 
    150          CASE ( jpdtdrvo )       
    151             CALL trd_vor_zint(ptrdx, ptrdy, jpvorrvo) 
    152  
    153          ! Planetary Vorticity Term trend 
    154          CASE ( jpdtdpvo )       
    155             CALL trd_vor_zint(ptrdx, ptrdy, jpvorpvo) 
    156  
    157          ! Horizontal Diffusion trend 
    158          CASE ( jpdtdldf )       
    159             CALL trd_vor_zint(ptrdx, ptrdy, jpvorldf) 
    160  
    161          ! Vertical Advection trend 
    162          CASE ( jpdtdzad )       
    163             CALL trd_vor_zint(ptrdx, ptrdy, jpvorzad) 
    164  
    165          ! Vertical Diffusion trend 
    166          CASE ( jpdtdzdf )       
    167             CALL trd_vor_zint(ptrdx, ptrdy, jpvorzdf) 
    168  
    169          ! Surface Pressure Grad. trend 
    170          CASE ( jpdtdspg )       
    171             CALL trd_vor_zint(ptrdx, ptrdy, jpvorspg) 
    172  
    173          ! Beta V trend  
    174          CASE ( jpdtddat )       
    175             CALL trd_vor_zint(ptrdx, ptrdy, jpvorbev) 
    176  
    177          ! Wind stress forcing term 
    178          CASE ( jpdtdswf )       
    179             z2dx(:,:) = ptrdx(:,:,1) 
    180             z2dy(:,:) = ptrdy(:,:,1) 
    181  
    182             CALL trd_vor_zint(z2dx, z2dy, jpvorswf) 
    183  
    184          ! Bottom friction term 
    185          CASE ( jpdtdbfr )       
    186             z2dx(:,:) = ptrdx(:,:,1) 
    187             z2dy(:,:) = ptrdy(:,:,1) 
    188  
    189             CALL trd_vor_zint(z2dx, z2dy, jpvorbfr) 
    190  
     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 
    191199         END SELECT 
    192  
     200         ! 
    193201      ENDIF 
    194202 
    195203      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    196       ! III. Mixed layer trends 
     204      ! III. Mixed layer trends for active tracers 
    197205      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    198206 
    199207      IF( lk_trdmld .AND. ctype == 'TRA' )   THEN 
    200208          
     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 purely vertical diffusion (and not iso-neutral), 
     217         !                   we do not need to store the corresponding trend here, since it 
     218         !                   is recomputed later (at the basis of the ML, see trd_mld) 
     219         !                 * else (iso-neutral case) we store the vertical diffusion component in the  
     220         !                   lateral trend including the K_z contrib, which will be removed later (see trd_mld) 
     221         !----------------------------------------------------------------------------------------------- 
     222 
    201223         SELECT CASE ( ktrd ) 
    202  
    203          ! horizontal advection trends 
    204          CASE ( jpttdlad )       
    205  
    206 #if defined key_trabbl_adv 
    207             ! Advective bottom boundary layer  
    208             ! ------------------------------- 
    209             zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:) 
    210             zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:) 
    211 #endif 
    212             IF( kt == nit000 )   zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    213  
    214             SELECT CASE ( l_adv ) 
    215  
    216             CASE ( 'ce2' ) 
    217  
    218                ! Split horizontal trends into i- and j- compnents for trdmld case  
    219                ! ---------------------------------------------------------------- 
    220  
    221                ! i- advective trend computed as Uh gradh(T) 
    222                DO jk = 1, jpkm1 
    223                   DO jj = 2, jpjm1 
    224                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    225 # if defined key_zco 
    226                         zbtr = zbtr2(ji,jj) 
    227                         zfui = 0.5 * e2u(ji  ,jj) * zun(ji,  jj,jk) 
    228                         zfui1= 0.5 * e2u(ji-1,jj) * zun(ji-1,jj,jk) 
    229 # else          
    230                         zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
    231                         zfui = 0.5 * e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk) 
    232                         zfui1= 0.5 * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk) 
    233 # endif 
    234                         ! save i- advective trend  
    235                         z3dx(ji,jj,jk) = - zbtr * ( zfui  * ( tn(ji+1,jj,jk) - tn(ji  ,jj,jk) )    & 
    236                             &                     + zfui1 * ( tn(ji  ,jj,jk) - tn(ji-1,jj,jk) ) ) 
    237                         z3dy(ji,jj,jk) = - zbtr * ( zfui  * ( sn(ji+1,jj,jk) - sn(ji  ,jj,jk) )    & 
    238                             &                     + zfui1 * ( sn(ji  ,jj,jk) - sn(ji-1,jj,jk) ) ) 
    239                      END DO 
    240                   END DO 
    241                END DO 
    242  
    243                ! save the i- horizontal trends for diagnostic 
    244                CALL trd_mld_zint(z3dx, z3dy, jpmldxad, '3D') 
    245  
    246                ! j- advective trend computed as Uh gradh(T) 
    247                DO jk = 1, jpkm1 
    248                   DO jj = 2, jpjm1 
    249                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    250 # if defined key_zco 
    251                         zbtr = zbtr2(ji,jj) 
    252                         zfvj = 0.5 * e1v(ji,jj  ) * zvn(ji,jj  ,jk) 
    253                         zfvj1= 0.5 * e1v(ji,jj-1) * zvn(ji,jj-1,jk) 
    254 # else          
    255                         zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
    256                         zfvj = 0.5 * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk) 
    257                         zfvj1= 0.5 * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk) 
    258 # endif 
    259                         ! save j- advective trend  
    260                         z3dx(ji,jj,jk) = - zbtr * ( zfvj  * ( tn(ji,jj+1,jk) - tn(ji,jj  ,jk) )   & 
    261                             &                     + zfvj1 * ( tn(ji,jj  ,jk) - tn(ji,jj-1,jk) ) ) 
    262                         z3dy(ji,jj,jk) = - zbtr * ( zfvj  * ( sn(ji,jj+1,jk) - sn(ji,jj  ,jk) )   & 
    263                             &                     + zfvj1 * ( sn(ji,jj  ,jk) - sn(ji,jj-1,jk) ) ) 
    264                      END DO 
    265                   END DO 
    266                END DO 
    267  
    268                ! save the j- horizontal trend for diagnostic 
    269                CALL trd_mld_zint(z3dx, z3dy, jpmldyad, '3D') 
    270  
    271             CASE ( 'tvd' ) 
    272  
    273                ! Recompute the horizontal advection term Div(Uh.T) term  
    274                z3dx(:,:,:) = ptrdx(:,:,:) - tn(:,:,:) * hdivn(:,:,:) 
    275                z3dy(:,:,:) = ptrdy(:,:,:) - sn(:,:,:) * hdivn(:,:,:) 
    276  
    277                ! Deduce the i- horizontal advection in substracting the j- one. 
    278                ! tladj()/sladj() are computed in traadv_tvd.F90 module 
    279                z3dx(:,:,:) = z3dx(:,:,:) - tladj(:,:,:) 
    280                z3dy(:,:,:) = z3dy(:,:,:) - sladj(:,:,:) 
    281  
    282                DO jk = 1, jpkm1 
    283                   DO jj = 2, jpjm1 
    284                      DO ji = fs_2, fs_jpim1 
    285                         zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
    286  
    287                         ! Compute the zonal et meridional divergence 
    288                         zfui = e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * zun(ji  ,jj,jk)  & 
    289                              - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk) 
    290                         zfvj = e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)  & 
    291                              - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk) 
    292  
    293                         ! i- advective trend computed as U gradx(T/S) 
    294                         z3dx(ji,jj,jk) = z3dx(ji,jj,jk) + tn(ji,jj,jk) * zfui * zbtr 
    295                         z3dy(ji,jj,jk) = z3dy(ji,jj,jk) + sn(ji,jj,jk) * zfui * zbtr 
    296  
    297                         ! j- advective trend computed as V grady(T/S) 
    298                         tladj(ji,jj,jk) = tladj(ji,jj,jk) + tn(ji,jj,jk) * zfvj * zbtr 
    299                         sladj(ji,jj,jk) = sladj(ji,jj,jk) + sn(ji,jj,jk) * zfvj * zbtr 
    300  
    301                      END DO 
    302                   END DO 
    303                END DO 
    304  
    305                ! save the i- horizontal trend for diagnostic 
    306                CALL trd_mld_zint(z3dx, z3dy, jpmldxad, '3D') 
    307  
    308                ! save the j- horizontal trend for diagnostic 
    309                CALL trd_mld_zint(tladj, sladi, jpmldyad, '3D') 
    310  
    311             CASE ( 'mus', 'mu2' ) 
    312  
    313                !  Split horizontal trends in i- and j- direction for trdmld case  
    314                ! ---------------------------------------------------------------- 
    315  
    316                ! i- advective trend computed as U gradx(T/S) 
    317                DO jk = 1, jpkm1 
    318                   DO jj = 2, jpjm1       
    319                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    320 # if defined key_zco 
    321                         zbtr = zbtr2(ji,jj) 
    322                         zfui = e2u(ji  ,jj) * zun(ji,  jj,jk)   & 
    323                            & - e2u(ji-1,jj) * zun(ji-1,jj,jk) 
    324 # else       
    325                         zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
    326                         zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk)   & 
    327                            & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk) 
    328 # endif 
    329                         ! save i- advective trend  
    330                         z3dx(ji,jj,jk) = - zbtr * ( tladi(ji,jj,jk) - tladi(ji-1,jj,jk) )   & 
    331                             &                      + tn(ji,jj,jk) * zfui * zbtr 
    332                         z3dy(ji,jj,jk) = - zbtr * ( sladi(ji,jj,jk) - sladi(ji-1,jj,jk) )  & 
    333                             &                      + sn(ji,jj,jk) * zfui * zbtr 
    334                      END DO 
    335                   END DO 
    336                END DO         
    337  
    338                ! save the i- horizontal trends for diagnostic 
    339                CALL trd_mld_zint(z3dx, z3dy, jpmldxad, '3D') 
    340  
    341                ! j- advective trend computed as V grady(T/S) 
    342                DO jk = 1, jpkm1 
    343                   DO jj = 2, jpjm1       
    344                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    345 # if defined key_zco 
    346                         zbtr = zbtr2(ji,jj) 
    347                         zfvj = e1v(ji,jj  ) * zvn(ji,jj  ,jk)   & 
    348                            & - e1v(ji,jj-1) * zvn(ji,jj-1,jk) 
    349 # else       
    350                         zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
    351                         zfvj =  e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)   & 
    352                            & -  e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk) 
    353 # endif 
    354                         ! save j- advective trend  
    355                         z3dx(ji,jj,jk) =  - zbtr * ( tladj(ji,jj,jk) - tladj(ji,jj-1,jk) )   & 
    356                             &                       + tn(ji,jj,jk) * zfvj * zbtr 
    357                         z3dy(ji,jj,jk) =  - zbtr * ( sladj(ji,jj,jk) - sladj(ji,jj-1,jk) )   & 
    358                             &                       + sn(ji,jj,jk) * zfvj * zbtr 
    359                      END DO 
    360                   END DO 
    361                END DO         
    362  
    363                ! save the j- horizontal trends for diagnostic 
    364                CALL trd_mld_zint(z3dx, z3dy, jpmldyad, '3D') 
    365  
    366             END SELECT 
    367  
    368          ! vertical advection trends 
    369          CASE ( jpttdzad )       
    370             CALL trd_mld_zint(ptrdx, ptrdy, jpmldzad, '3D') 
    371  
    372          ! lateral diffusion trends 
    373          CASE ( jpttdldf )       
    374             CALL trd_mld_zint(ptrdx, ptrdy, jpmldldf, '3D') 
    375 # if defined key_traldf_eiv 
    376             ! Save the i- and j- eddy induce velocity trends 
    377             CALL trd_mld_zint(tladi, sladi, jpmldxei, '3D') 
    378             CALL trd_mld_zint(tladj, sladj, jpmldyei, '3D') 
    379 # endif 
    380             IF( lk_trabbl_dif )   THEN 
    381                z3dx(:,:,:) = 0.e0 
    382                z3dy(:,:,:) = 0.e0 
    383                z3dx(:,:,1) = tldfbbl(:,:) 
    384                z3dy(:,:,1) = sldfbbl(:,:) 
    385                CALL trd_mld_zint(z3dx, z3dy, jpmldldf, '2D') 
    386             ENDIF 
    387  
    388          ! vertical diffusion trends 
    389          CASE ( jpttdzdf )       
    390             CALL trd_mld_zint(ptrdx, ptrdy, jpmldzdf, '3D') 
    391  
    392          ! vertical diffusion trends 
    393          CASE ( jpttddoe )       
    394             CALL trd_mld_zint(ptrdx, ptrdy, jpmldzei, '3D') 
    395  
    396          ! penetrative solar radiation trends 
    397          CASE ( jpttdqsr )       
    398             CALL trd_mld_zint(ptrdx, ptrdy, jpmldfor, '3D') 
    399  
    400          ! non penetrative solar radiation trends 
    401          CASE ( jpttdnsr ) 
    402             ptrdx(:,:,2:jpk) = 0.e0 
    403             ptrdy(:,:,2:jpk) = 0.e0 
    404             CALL trd_mld_zint(ptrdx, ptrdy, jpmldfor, '2D') 
    405  
    406          END SELECT    
     224         CASE ( jptra_trd_xad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_xad, '3D' )   ! merid. advection 
     225         CASE ( jptra_trd_yad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_yad, '3D' )   ! zonal  advection 
     226         CASE ( jptra_trd_zad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zad, '3D' )   ! vertical advection 
     227         CASE ( jptra_trd_ldf )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' )   ! lateral diffusive 
     228         CASE ( jptra_trd_bbl )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbl, '3D' )   ! bottom boundary layer 
     229         CASE ( jptra_trd_zdf ) 
     230            IF( ln_traldf_iso )       CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' )   ! vertical diffusion (K_z) 
     231         CASE ( jptra_trd_dmp )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_dmp, '3D' )   ! internal 3D restoring (tradmp) 
     232         CASE ( jptra_trd_qsr )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '3D' )   ! air-sea : penetrative sol radiat 
     233         CASE ( jptra_trd_nsr ) 
     234            ptrdx(:,:,2:jpk) = 0.e0   ;   ptrdy(:,:,2:jpk) = 0.e0 
     235            CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '2D' )                             ! air-sea : non penetr sol radiat 
     236         CASE ( jptra_trd_bbc )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbc, '3D' )   ! bottom bound cond (geoth flux) 
     237         CASE ( jptra_trd_atf )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_atf, '3D' )   ! asselin numerical 
     238         CASE ( jptra_trd_npc )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_npc, '3D' )   ! non penetr convect adjustment 
     239         END SELECT 
    407240 
    408241      ENDIF 
    409  
    410242 
    411243   END SUBROUTINE trd_mod 
    … …  
    434266#   endif 
    435267 
     268   SUBROUTINE trd_mod_init 
     269      !!---------------------------------------------------------------------- 
     270      !!                  ***  ROUTINE trd_mod_init  *** 
     271      !!  
     272      !! ** Purpose :   Initialization of activated trends 
     273      !!---------------------------------------------------------------------- 
     274      USE in_out_manager          ! I/O manager 
     275 
     276      NAMELIST/namtrd/ ntrd, nctls, ln_trdmld_restart, ucf, ln_trdmld_instant 
     277      !!---------------------------------------------------------------------- 
     278 
     279      IF( l_trdtra .OR. l_trddyn )   THEN 
     280         REWIND( numnam ) 
     281         READ  ( numnam, namtrd )      ! namelist namtrd : trends diagnostic 
     282 
     283         IF(lwp) THEN 
     284            WRITE(numout,*) 
     285            WRITE(numout,*) ' trd_mod_init : Momentum/Tracers trends' 
     286            WRITE(numout,*) ' ~~~~~~~~~~~~~' 
     287            WRITE(numout,*) '       Namelist namtrd : set trends parameters' 
     288            WRITE(numout,*) '           * frequency of trends diagnostics   ntrd               = ', ntrd 
     289            WRITE(numout,*) '           * control surface type              nctls              = ', nctls 
     290            WRITE(numout,*) '           * restart for ML diagnostics        ln_trdmld_restart  = ', ln_trdmld_restart 
     291            WRITE(numout,*) '           * instantaneous or mean ML T/S      ln_trdmld_instant  = ', ln_trdmld_instant 
     292            WRITE(numout,*) '           * unit conversion factor            ucf                = ', ucf 
     293        ENDIF 
     294      ENDIF 
     295      ! 
     296      IF( lk_trddyn .OR. lk_trdtra )    CALL trd_icp_init       ! integral constraints trends 
     297      IF( lk_trdmld                )    CALL trd_mld_init       ! mixed-layer trends (active  tracers)   
     298      IF( lk_trdvor                )    CALL trd_vor_init       ! vorticity trends         
     299      ! 
     300   END SUBROUTINE trd_mod_init 
     301 
    436302   !!====================================================================== 
    437303END MODULE trdmod 

  • trunk/NEMO/OPA_SRC/TRD/trdmod_oce.F90

    r247 r503  
    44   !! Ocean trends :   set tracer and momentum trend variables 
    55   !!====================================================================== 
     6   !! History :  9.0  !  04-08  (C. Talandier) Original code 
    67   !!---------------------------------------------------------------------- 
    7    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    8    !! $Header$  
    9    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    10    !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    128   USE trdicp_oce              ! ocean momentum/tracers bassin properties trends variables 
    139   USE trdmld_oce              ! ocean active mixed layer tracers trends variables 
    1410   USE trdvor_oce              ! ocean vorticity trends variables 
    1511 
    16    !! Control parameters 
     12   IMPLICIT NONE 
     13   PUBLIC 
     14 
     15   !!* Namelist namtrd:  diagnostics on dynamics/tracer trends 
     16   INTEGER , PUBLIC ::    ntrd  = 10                    !: time step frequency dynamics and tracers trends 
     17   INTEGER , PUBLIC ::    nctls =  0                    !: control surface type for trends vertical integration 
     18   REAL(wp), PUBLIC ::    ucf   = 1.                    !: unit conversion factor (for netCDF trends outputs) 
     19                                                        !: =1. (=86400.) for degC/s (degC/day) and psu/s (psu/day) 
     20   LOGICAL , PUBLIC ::    ln_trdmld_instant = .FALSE.   !: flag to diagnose inst./mean ML T/S trends 
     21   LOGICAL , PUBLIC ::    ln_trdmld_restart = .FALSE.   !: flag to restart mixed-layer diagnostics 
     22 
     23   !!* Control parameters 
     24# if defined key_trdtra   ||   defined key_trdmld 
     25   LOGICAL , PUBLIC ::   l_trdtra = .TRUE.              !: tracers  trend flag 
     26# else 
     27   LOGICAL , PUBLIC ::   l_trdtra = .FALSE.             !: tracers  trend flag 
     28# endif 
     29# if defined key_trddyn   ||   defined key_trdvor 
     30   LOGICAL , PUBLIC ::   l_trddyn = .TRUE.              !: momentum trend flag 
     31# else 
     32   LOGICAL , PUBLIC ::   l_trddyn = .FALSE.             !: momentum trend flag 
     33# endif 
     34 
     35   !!* 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 
     48    
     49   !!* Momentum trends indexes 
     50   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_hpg =  1   !: hydrostatic pressure gradient  
     51   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_keg =  2   !: kinetic energy gradient 
     52   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_rvo =  3   !: relative vorticity 
     53   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_pvo =  4   !: planetary vorticity 
     54   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_ldf =  5   !: lateral diffusion 
     55   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zad =  6   !: vertical advection 
     56   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zdf =  7   !: vertical diffusion 
     57   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_spg =  8   !: surface pressure gradient 
     58   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_dat =  9   !: damping term 
     59   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_swf = 10   !: surface wind forcing 
     60   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_bfr = 11   !: bottom friction  
     61 
    1762   !!---------------------------------------------------------------------- 
    18    LOGICAL, PUBLIC ::   l_trdtra = .FALSE.    !: tracers  trend flag 
    19    LOGICAL, PUBLIC ::   l_trddyn = .FALSE.    !: momentum trend flag 
    20  
    21   !!====================================================================== 
     63   !!  OPA 9.0 , LOCEAN-IPSL (2006)  
     64   !! $Header$  
     65   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     66   !!====================================================================== 
    2267END MODULE trdmod_oce 

  • trunk/NEMO/OPA_SRC/TRD/trdvor.F90

    r462 r503  
    44   !! Ocean diagnostics:  momentum trends 
    55   !!===================================================================== 
    6     
     6   !! History :  9.0  !  04-06  (L. Brunier, A-M. Treguier) Original code  
     7   !!                 !  04-08  (C. Talandier) New trends organization 
     8   !!---------------------------------------------------------------------- 
    79#if defined key_trdvor   ||   defined key_esopa 
    810   !!---------------------------------------------------------------------- 
    911   !!   'key_trdvor'   : momentum trend diagnostics 
     12   !!---------------------------------------------------------------------- 
    1013   !!---------------------------------------------------------------------- 
    1114   !!   trd_vor      : momentum trends averaged over the depth 
    … …  
    1316   !!   trd_vor_init : initialization step 
    1417   !!---------------------------------------------------------------------- 
    15    !! * Modules used 
    1618   USE oce             ! ocean dynamics and tracers variables 
    1719   USE dom_oce         ! ocean space and time domain variables 
    … …  
    2729   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2830 
    29  
    3031   IMPLICIT NONE 
    3132   PRIVATE 
    3233 
    33    !! * Interfaces 
    3434   INTERFACE trd_vor_zint 
    3535      MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d 
    3636   END INTERFACE 
    3737 
    38    !! * Accessibility 
    39    PUBLIC trd_vor        ! routine called by step.F90 
    40    PUBLIC trd_vor_zint   ! routine called by dynamics routines 
    41    PUBLIC trd_vor_init   ! routine called by opa.F90 
    42  
    43    !! * Shared module variables 
    44    LOGICAL, PUBLIC ::   lk_trdvor = .TRUE.   ! momentum trend flag 
    45  
    46    !! * Module variables 
     38   PUBLIC   trd_vor        ! routine called by step.F90 
     39   PUBLIC   trd_vor_zint   ! routine called by dynamics routines 
     40   PUBLIC   trd_vor_init   ! routine called by opa.F90 
     41 
    4742   INTEGER ::                & 
    4843      nh_t, nmoydpvor  ,     & 
    … …  
    6156     vor_avrres 
    6257 
    63    REAL(wp), DIMENSION(jpi,jpj,jplvor)::   &  !: curl of trends 
    64       vortrd    
    65  
     58   REAL(wp), DIMENSION(jpi,jpj,jpltot_vor)::   vortrd  !: curl of trends 
     59          
    6660   CHARACTER(len=12) ::   cvort 
    6761 
    … …  
    7064#  include "ldfdyn_substitute.h90" 
    7165#  include "vectopt_loop_substitute.h90" 
    72  
    7366   !!---------------------------------------------------------------------- 
    7467   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    7568   !! $Header$  
    76    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     69   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    7770   !!---------------------------------------------------------------------- 
    7871   
    … …  
    8073 
    8174   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 
     75      !!---------------------------------------------------------------------------- 
     76      !!                  ***  ROUTINE trd_vor_zint  *** 
     77      !! 
     78      !! ** Purpose :   computation of vertically integrated vorticity budgets 
     79      !!      from ocean surface down to control surface (NetCDF output) 
     80      !! 
     81      !! ** Method/usage : 
     82      !!      integration done over nwrite-1 time steps 
     83      !! 
     84      !! 
     85      !! ** Action : 
     86      !!            /comvor/   : 
     87      !!                         vor_avr          average 
     88      !!                         vor_avrb         vorticity at kt-1 
     89      !!                         vor_avrbb        vorticity at begining of the NWRITE-1 
     90      !!                                          time steps averaging period 
     91      !!                         vor_avrbn         vorticity at time step after the 
     92      !!                                          begining of the NWRITE-1 time 
     93      !!                                          steps averaging period 
     94      !! 
     95      !!                 trends : 
     96      !! 
     97      !!                  vortrd (,, 1) = Pressure Gradient Trend 
     98      !!                  vortrd (,, 2) = KE Gradient Trend 
     99      !!                  vortrd (,, 3) = Relative Vorticity Trend 
     100      !!                  vortrd (,, 4) = Coriolis Term Trend 
     101      !!                  vortrd (,, 5) = Horizontal Diffusion Trend 
     102      !!                  vortrd (,, 6) = Vertical Advection Trend 
     103      !!                  vortrd (,, 7) = Vertical Diffusion Trend 
     104      !!                  vortrd (,, 8) = Surface Pressure Grad. Trend 
     105      !!                  vortrd (,, 9) = Beta V 
     106      !!                  vortrd (,,10) = forcing term 
     107      !!      vortrd (,,11) = bottom friction term 
     108      !!                  rotot(,) : total cumulative trends over nwrite-1 time steps 
     109      !!                  vor_avrtot(,) : first membre of vrticity equation 
     110      !!                  vor_avrres(,) : residual = dh/dt entrainment 
     111      !! 
     112      !!      trends output in netCDF format using ioipsl 
     113      !! 
     114      !!---------------------------------------------------------------------- 
     115      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
     116      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   & 
     117         putrdvor,                         &  ! u vorticity trend  
     118         pvtrdvor                             ! v vorticity trend 
     119      !! 
     120      INTEGER ::   ji, jj 
     121      INTEGER ::   ikbu, ikbum1, ikbv, ikbvm1 
     122      REAL(wp), DIMENSION(jpi,jpj) ::   zudpvor, zvdpvor   ! total cmulative trends 
     123      !!---------------------------------------------------------------------- 
     124 
     125      ! Initialization 
     126      zudpvor(:,:) = 0.e0 
     127      zvdpvor(:,:) = 0.e0 
     128 
     129      CALL lbc_lnk( putrdvor,  'U' , -1. ) 
     130      CALL lbc_lnk( pvtrdvor,  'V' , -1. ) 
     131 
     132      !  ===================================== 
     133      !  I vertical integration of 2D trends 
     134      !  ===================================== 
     135 
     136      SELECT CASE (ktrd)  
     137 
     138      CASE (jpvor_bfr)        ! bottom friction 
     139 
     140         DO jj = 2, jpjm1 
     141            DO ji = fs_2, fs_jpim1  
     142               ikbu   = min( mbathy(ji+1,jj), mbathy(ji,jj) ) 
     143               ikbum1 = max( ikbu-1, 1 ) 
     144               ikbv   = min( mbathy(ji,jj+1), mbathy(ji,jj) ) 
     145               ikbvm1 = max( ikbv-1, 1 ) 
     146             
     147               zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbum1) * e1u(ji,jj) * umask(ji,jj,ikbum1) 
     148               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbvm1) * e2v(ji,jj) * vmask(ji,jj,ikbvm1) 
     149            END DO 
     150         END DO 
     151 
     152      CASE (jpvor_swf)        ! wind stress 
     153 
     154         zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 
     155         zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) 
     156 
     157      END SELECT 
     158 
     159      ! Average except for Beta.V 
     160      zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 
     161      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 
     162    
     163      ! Curl 
     164      DO ji=1,jpim1 
     165         DO jj=1,jpjm1 
     166            vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj)        & 
     167                 &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 
     168                 &               / ( e1f(ji,jj) * e2f(ji,jj) ) 
     169         END DO 
     170      END DO 
     171 
     172      ! Surface mask 
     173      vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 
     174 
     175      IF( idebug /= 0 ) THEN 
     176         IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done' 
     177         CALL FLUSH(numout) 
     178      ENDIF 
     179      ! 
     180   END SUBROUTINE trd_vor_zint_2d 
     181 
     182 
     183   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 
    82184      !!---------------------------------------------------------------------------- 
    83185      !!                  ***  ROUTINE trd_vor_zint  *** 
    … …  
    119221      !!      trends output in netCDF format using ioipsl 
    120222      !! 
    121       !! History : 
    122       !!   9.0  !  04-06  (L. Brunier, A-M. Treguier) Original code  
    123       !!        !  04-08  (C. Talandier) New trends organization 
    124       !!---------------------------------------------------------------------- 
    125       !! * Arguments 
     223      !!---------------------------------------------------------------------- 
    126224      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
    127  
    128       REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   & 
    129          putrdvor,                         &  ! u vorticity trend  
    130          pvtrdvor                             ! v vorticity trend 
    131  
    132       !! * Local declarations 
    133       INTEGER ::   ji, jj 
    134       INTEGER ::   ikbu, ikbum1, ikbv, ikbvm1 
    135       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    136          zudpvor,                       &  ! total cmulative trends 
    137          zvdpvor                           !   "      "        " 
    138       !!---------------------------------------------------------------------- 
    139  
    140       ! Initialization 
    141       zudpvor(:,:) = 0.e0 
    142       zvdpvor(:,:) = 0.e0 
    143  
    144       CALL lbc_lnk( putrdvor,  'U' , -1. ) 
    145       CALL lbc_lnk( pvtrdvor,  'V' , -1. ) 
    146  
    147       !  ===================================== 
    148       !  I vertical integration of 2D trends 
    149       !  ===================================== 
    150  
    151       SELECT CASE (ktrd)  
    152  
    153       CASE (jpvorbfr)        ! bottom friction 
    154  
    155          DO jj = 2, jpjm1 
    156             DO ji = fs_2, fs_jpim1  
    157                ikbu   = min( mbathy(ji+1,jj), mbathy(ji,jj) ) 
    158                ikbum1 = max( ikbu-1, 1 ) 
    159                ikbv   = min( mbathy(ji,jj+1), mbathy(ji,jj) ) 
    160                ikbvm1 = max( ikbv-1, 1 ) 
    161              
    162                zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbum1) * e1u(ji,jj) * umask(ji,jj,ikbum1) 
    163                zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbvm1) * e2v(ji,jj) * vmask(ji,jj,ikbvm1) 
    164             END DO 
    165          END DO 
    166  
    167       CASE (jpvorswf)        ! wind stress 
    168  
    169          zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 
    170          zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) 
    171  
    172       END SELECT 
    173  
    174       ! Average except for Beta.V 
    175       zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 
    176       zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 
    177     
    178       ! Curl 
    179       DO ji=1,jpim1 
    180          DO jj=1,jpjm1 
    181             vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj)        & 
    182                  &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 
    183                  &               / ( e1f(ji,jj) * e2f(ji,jj) ) 
    184          END DO 
    185       END DO 
    186  
    187       ! Surface mask 
    188       vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 
    189  
    190       IF( idebug /= 0 ) THEN 
    191          IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done' 
    192          CALL FLUSH(numout) 
    193       ENDIF 
    194  
    195    END SUBROUTINE trd_vor_zint_2d 
    196  
    197  
    198  
    199    SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 
    200       !!---------------------------------------------------------------------------- 
    201       !!                  ***  ROUTINE trd_vor_zint  *** 
    202       !! 
    203       !! ** Purpose :   computation of vertically integrated vorticity budgets 
    204       !!      from ocean surface down to control surface (NetCDF output) 
    205       !! 
    206       !! ** Method/usage : 
    207       !!      integration done over nwrite-1 time steps 
    208       !! 
    209       !! 
    210       !! ** Action : 
    211       !!            /comvor/   : 
    212       !!                         vor_avr          average 
    213       !!                         vor_avrb         vorticity at kt-1 
    214       !!                         vor_avrbb        vorticity at begining of the NWRITE-1 
    215       !!                                          time steps averaging period 
    216       !!                         vor_avrbn         vorticity at time step after the 
    217       !!                                          begining of the NWRITE-1 time 
    218       !!                                          steps averaging period 
    219       !! 
    220       !!                 trends : 
    221       !! 
    222       !!                  vortrd (,,1) = Pressure Gradient Trend 
    223       !!                  vortrd (,,2) = KE Gradient Trend 
    224       !!                  vortrd (,,3) = Relative Vorticity Trend 
    225       !!                  vortrd (,,4) = Coriolis Term Trend 
    226       !!                  vortrd (,,5) = Horizontal Diffusion Trend 
    227       !!                  vortrd (,,6) = Vertical Advection Trend 
    228       !!                  vortrd (,,7) = Vertical Diffusion Trend 
    229       !!                  vortrd (,,8) = Surface Pressure Grad. Trend 
    230       !!                  vortrd (,,9) = Beta V 
    231       !!                  vortrd (,,10) = forcing term 
    232       !!      vortrd (,,11) = bottom friction term 
    233       !!                  rotot(,) : total cumulative trends over nwrite-1 time steps 
    234       !!                  vor_avrtot(,) : first membre of vrticity equation 
    235       !!                  vor_avrres(,) : residual = dh/dt entrainment 
    236       !! 
    237       !!      trends output in netCDF format using ioipsl 
    238       !! 
    239       !! History : 
    240       !!   9.0  !  04-06  (L. Brunier, A-M. Treguier) Original code  
    241       !!        !  04-08  (C. Talandier) New trends organization 
    242       !!---------------------------------------------------------------------- 
    243       !! * Arguments 
    244       INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
    245  
    246225      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
    247226         putrdvor,                         &  ! u vorticity trend  
    248227         pvtrdvor                             ! v vorticity trend 
    249  
    250       !! * Local declarations 
     228      !! 
    251229      INTEGER ::   ji, jj, jk 
    252  
    253230      REAL(wp), DIMENSION(jpi,jpj) ::   & 
    254231         zubet,                         &  ! u Beta.V case 
    … …  
    279256      ! Save Beta.V term to avoid average before Curl 
    280257      ! Beta.V : intergration, no average 
    281       IF( ktrd == jpvorbev ) THEN  
     258      IF( ktrd == jpvor_bev ) THEN  
    282259         zubet(:,:) = zudpvor(:,:) 
    283260         zvbet(:,:) = zvdpvor(:,:) 
    … …  
    302279      ! Special treatement for the Beta.V term 
    303280      ! Compute the Curl of the Beta.V term which is not averaged 
    304       IF( ktrd == jpvorbev ) THEN 
     281      IF( ktrd == jpvor_bev ) THEN 
    305282         DO ji=1,jpim1 
    306283            DO jj=1,jpjm1 
    307                vortrd(ji,jj,jpvorbev) = (  zvbet(ji+1,jj) - zvbet(ji,jj) -   & 
     284               vortrd(ji,jj,jpvor_bev) = (  zvbet(ji+1,jj) - zvbet(ji,jj) -   & 
    308285                    &                    ( zubet(ji,jj+1) - zubet(ji,jj) ) ) & 
    309286                    &                   / ( e1f(ji,jj) * e2f(ji,jj) ) 
    … …  
    312289 
    313290         ! Average on the Curl 
    314          vortrd(:,:,jpvorbev) = vortrd(:,:,jpvorbev) * hur(:,:) 
     291         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) 
    315292 
    316293         ! Surface mask 
    317          vortrd(:,:,jpvorbev) = vortrd(:,:,jpvorbev) * fmask(:,:,1) 
     294         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * fmask(:,:,1) 
    318295      ENDIF 
    319296    
    … …  
    322299         CALL FLUSH(numout) 
    323300      ENDIF 
    324  
     301      ! 
    325302   END SUBROUTINE trd_vor_zint_3d 
    326  
    327303 
    328304 
    … …  
    333309      !! ** Purpose :  computation of cumulated trends over analysis period 
    334310      !!               and make outputs (NetCDF or DIMG format) 
    335       !! 
    336       !! ** Method/usage : 
    337       !! 
    338       !! History : 
    339       !!   9.0  !  04-06  (L. Brunier, A-M. Treguier) Original code  
    340       !!        !  04-08  (C. Talandier) New trends organization 
    341       !!---------------------------------------------------------------------- 
    342       !! * Arguments 
     311      !!---------------------------------------------------------------------- 
    343312      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    344  
    345       !! * Local declarations 
    346       INTEGER :: ji, jj, jk, jl, it 
    347  
    348       REAL(wp) :: zmean 
    349  
    350       REAL(wp) ,DIMENSION(jpi,jpj) ::   & 
    351          zun, zvn 
     313      !! 
     314      INTEGER  ::   ji, jj, jk, jl, it 
     315      REAL(wp) ::   zmean 
     316      REAL(wp), DIMENSION(jpi,jpj) ::   zun, zvn 
    352317      !!---------------------------------------------------------------------- 
    353318 
    … …  
    424389      IF( kt >= nit000+2 ) THEN 
    425390         nmoydpvor = nmoydpvor + 1 
    426          DO jl = 1, jplvor 
     391         DO jl = 1, jpltot_vor 
    427392            IF( jl /= 9 ) THEN 
    428393               rotot(:,:) = rotot(:,:) + vortrd(:,:,jl) 
    … …  
    490455         it= kt-nit000+1 
    491456         IF( lwp .AND. MOD( kt, ntrd ) == 0 ) THEN 
    492             WRITE(numout,*) '     trdvor_ncwrite : write NetCDF fields' 
     457            WRITE(numout,*) '' 
     458            WRITE(numout,*) 'trd_vor : write trends in the NetCDF file at kt = ', kt 
     459            WRITE(numout,*) '~~~~~~~  ' 
    493460         ENDIF 
    494461  
    495          CALL histwrite( nidvor,"sovortPh",it,vortrd(:,:,1),ndimvor1,ndexvor1)  ! grad Ph 
    496          CALL histwrite( nidvor,"sovortEk",it,vortrd(:,:,2),ndimvor1,ndexvor1)  ! Energy 
    497          CALL histwrite( nidvor,"sovozeta",it,vortrd(:,:,3),ndimvor1,ndexvor1)  ! rel vorticity 
    498          CALL histwrite( nidvor,"sovortif",it,vortrd(:,:,4),ndimvor1,ndexvor1)  ! coriolis 
    499          CALL histwrite( nidvor,"sovodifl",it,vortrd(:,:,5),ndimvor1,ndexvor1)  ! lat diff 
    500          CALL histwrite( nidvor,"sovoadvv",it,vortrd(:,:,6),ndimvor1,ndexvor1)  ! vert adv 
    501          CALL histwrite( nidvor,"sovodifv",it,vortrd(:,:,7),ndimvor1,ndexvor1)  ! vert diff 
    502          CALL histwrite( nidvor,"sovortPs",it,vortrd(:,:,8),ndimvor1,ndexvor1)  ! grad Ps 
    503          CALL histwrite( nidvor,"sovortbv",it,vortrd(:,:,9),ndimvor1,ndexvor1)  ! beta.V 
    504          CALL histwrite( nidvor,"sovowind",it,vortrd(:,:,10),ndimvor1,ndexvor1) ! wind stress 
    505          CALL histwrite( nidvor,"sovobfri",it,vortrd(:,:,11),ndimvor1,ndexvor1) ! bottom friction 
     462         CALL histwrite( nidvor,"sovortPh",it,vortrd(:,:,jpvor_prg),ndimvor1,ndexvor1)  ! grad Ph 
     463         CALL histwrite( nidvor,"sovortEk",it,vortrd(:,:,jpvor_keg),ndimvor1,ndexvor1)  ! Energy 
     464         CALL histwrite( nidvor,"sovozeta",it,vortrd(:,:,jpvor_rvo),ndimvor1,ndexvor1)  ! rel vorticity 
     465         CALL histwrite( nidvor,"sovortif",it,vortrd(:,:,jpvor_pvo),ndimvor1,ndexvor1)  ! coriolis 
     466         CALL histwrite( nidvor,"sovodifl",it,vortrd(:,:,jpvor_ldf),ndimvor1,ndexvor1)  ! lat diff 
     467         CALL histwrite( nidvor,"sovoadvv",it,vortrd(:,:,jpvor_zad),ndimvor1,ndexvor1)  ! vert adv 
     468         CALL histwrite( nidvor,"sovodifv",it,vortrd(:,:,jpvor_zdf),ndimvor1,ndexvor1)  ! vert diff 
     469         CALL histwrite( nidvor,"sovortPs",it,vortrd(:,:,jpvor_spg),ndimvor1,ndexvor1)  ! grad Ps 
     470         CALL histwrite( nidvor,"sovortbv",it,vortrd(:,:,jpvor_bev),ndimvor1,ndexvor1)  ! beta.V 
     471         CALL histwrite( nidvor,"sovowind",it,vortrd(:,:,jpvor_swf),ndimvor1,ndexvor1) ! wind stress 
     472         CALL histwrite( nidvor,"sovobfri",it,vortrd(:,:,jpvor_bfr),ndimvor1,ndexvor1) ! bottom friction 
    506473         CALL histwrite( nidvor,"1st_mbre",it,vor_avrtot    ,ndimvor1,ndexvor1) ! First membre 
    507474         CALL histwrite( nidvor,"sovorgap",it,vor_avrres    ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre 
    508  
     475         ! 
    509476         IF( idebug /= 0 ) THEN 
    510477            WRITE(numout,*) ' debuging trd_vor: III.4 done' 
    511478            CALL FLUSH(numout) 
    512479         ENDIF 
    513  
    514       ENDIF 
    515  
     480         ! 
     481      ENDIF 
     482      ! 
    516483      IF( MOD( kt - nit000+1, ntrd ) == 0 ) rotot(:,:)=0 
    517  
     484      ! 
    518485      IF( kt == nitend )   CALL histclo( nidvor ) 
    519  
     486      ! 
    520487   END SUBROUTINE trd_vor 
    521  
    522488 
    523489 
    … …  
    528494      !! ** Purpose :   computation of vertically integrated T and S budgets 
    529495      !!      from ocean surface down to control surface (NetCDF output) 
    530       !! 
    531       !! ** Method/usage : 
    532       !! 
    533       !! History : 
    534       !!   9.0  !  04-06  (L. Brunier, A-M. Treguier) Original code  
    535       !!        !  04-08  (C. Talandier) New trends organization 
    536       !!---------------------------------------------------------------------- 
    537       !! * Local declarations 
    538       REAL(wp) :: zjulian, zsto, zout 
    539  
     496      !!---------------------------------------------------------------------- 
     497      REAL(wp) ::   zjulian, zsto, zout 
    540498      CHARACTER (len=40) ::   clhstnam 
    541499      CHARACTER (len=40) ::   clop 
    542  
    543       NAMELIST/namtrd/ ntrd,nctls 
    544500      !!---------------------------------------------------------------------- 
    545501 
    … …  
    553509      idebug = 0      ! set it to 1 in case of problem to have more Print 
    554510 
    555       ! namelist namtrd : trend diagnostic 
    556       REWIND( numnam ) 
    557       READ  ( numnam, namtrd ) 
    558  
    559511      IF(lwp) THEN 
    560512         WRITE(numout,*) ' ' 
    561          WRITE(numout,*) 'trd_vor_init: vorticity trends' 
    562          WRITE(numout,*) '~~~~~~~~~~~~~' 
     513         WRITE(numout,*) ' trd_vor_init: vorticity trends' 
     514         WRITE(numout,*) ' ~~~~~~~~~~~~' 
    563515         WRITE(numout,*) ' ' 
    564          WRITE(numout,*) '          Namelist namtrd : ' 
    565          WRITE(numout,*) '             time step frequency trend       ntrd  = ',ntrd 
    566          WRITE(numout,*) ' ' 
    567          WRITE(numout,*) '##########################################################################' 
    568          WRITE(numout,*) ' CAUTION: The interpretation of the vorticity trends is' 
    569          WRITE(numout,*) ' not obvious, please contact Anne-Marie TREGUIER at: treguier@ifremer.fr ' 
    570          WRITE(numout,*) '##########################################################################' 
     516         WRITE(numout,*) '               ##########################################################################' 
     517         WRITE(numout,*) '                CAUTION: The interpretation of the vorticity trends is' 
     518         WRITE(numout,*) '                not obvious, please contact Anne-Marie TREGUIER at: treguier@ifremer.fr ' 
     519         WRITE(numout,*) '               ##########################################################################' 
    571520         WRITE(numout,*) ' ' 
    572521      ENDIF 
    … …  
    599548      zout = ntrd*rdt 
    600549 
    601       IF(lwp) WRITE (numout,*) ' trdvor_ncinit: netCDF initialization' 
     550      IF(lwp) WRITE(numout,*) '              netCDF initialization' 
    602551 
    603552      ! II.2 Compute julian date from starting date of the run 
    604553      ! ------------------------ 
    605554      CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian ) 
    606       IF (lwp) WRITE(numout,*)' '   
    607       IF (lwp) WRITE(numout,*)' Date 0 used :',nit000         & 
    608            ,' YEAR ', nyear,' MONTH ', nmonth,' DAY ', nday   & 
    609            ,'Julian day : ', zjulian 
     555      IF(lwp) WRITE(numout,*)' '   
     556      IF(lwp) WRITE(numout,*)'               Date 0 used :',nit000,    & 
     557         &                   ' YEAR ', nyear,' MONTH '      , nmonth,   & 
     558         &                   ' DAY ' , nday, 'Julian day : ', zjulian 
    610559 
    611560      ! II.3 Define the T grid trend file (nidvor) 
    … …  
    650599         CALL FLUSH(numout) 
    651600      ENDIF 
    652  
     601      ! 
    653602   END SUBROUTINE trd_vor_init 
    654603 
    … …  
    657606   !!   Default option :                                       Empty module 
    658607   !!---------------------------------------------------------------------- 
    659    LOGICAL, PUBLIC ::   lk_trdvor = .FALSE.   ! momentum trend flag 
    660  
    661    !! * Interfaces 
    662608   INTERFACE trd_vor_zint 
    663609      MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d 
    664610   END INTERFACE 
    665  
    666611CONTAINS 
    667612   SUBROUTINE trd_vor( kt )        ! Empty routine 
    … …  
    669614   END SUBROUTINE trd_vor 
    670615   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 
    671       REAL, DIMENSION(:,:), INTENT( inout ) ::   & 
    672          putrdvor, pvtrdvor                  ! U and V momentum trends 
     616      REAL, DIMENSION(:,:), INTENT( inout ) ::   putrdvor, pvtrdvor 
    673617      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
    674618      WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1) 
    … …  
    677621   END SUBROUTINE trd_vor_zint_2d 
    678622   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 
    679       REAL, DIMENSION(:,:,:), INTENT( inout ) ::   & 
    680          putrdvor, pvtrdvor                  ! U and V momentum trends 
     623      REAL, DIMENSION(:,:,:), INTENT( inout ) ::   putrdvor, pvtrdvor 
    681624      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
    682625      WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1) 

  • trunk/NEMO/OPA_SRC/TRD/trdvor_oce.F90

    r247 r503  
    44   !! Ocean trends :   set vorticity trend variables 
    55   !!====================================================================== 
     6   !! History :  9.0  ! ??? 
     7   !!---------------------------------------------------------------------- 
     8 
     9   !!---------------------------------------------------------------------- 
     10   USE par_oce      ! ocean parameters 
     11 
     12   IMPLICIT NONE 
     13   PRIVATE 
     14 
     15#if defined key_trdvor 
     16   LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .TRUE.     !: momentum trend flag 
     17#else 
     18   LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .FALSE.    !: momentum trend flag 
     19#endif 
     20   !!* vorticity trends index 
     21   INTEGER, PUBLIC, PARAMETER ::   jpltot_vor = 11  !: Number of vorticity trend terms 
     22   ! 
     23   INTEGER, PUBLIC, PARAMETER ::   jpvor_prg =  1   !: Pressure Gradient Trend 
     24   INTEGER, PUBLIC, PARAMETER ::   jpvor_keg =  2   !: KE Gradient Trend 
     25   INTEGER, PUBLIC, PARAMETER ::   jpvor_rvo =  3   !: Relative Vorticity Trend 
     26   INTEGER, PUBLIC, PARAMETER ::   jpvor_pvo =  4   !: Planetary Vorticity Term Trend 
     27   INTEGER, PUBLIC, PARAMETER ::   jpvor_ldf =  5   !: Horizontal Diffusion Trend 
     28   INTEGER, PUBLIC, PARAMETER ::   jpvor_zad =  6   !: Vertical Advection Trend 
     29   INTEGER, PUBLIC, PARAMETER ::   jpvor_zdf =  7   !: Vertical Diffusion Trend 
     30   INTEGER, PUBLIC, PARAMETER ::   jpvor_spg =  8   !: Surface Pressure Grad. Trend 
     31   INTEGER, PUBLIC, PARAMETER ::   jpvor_bev =  9   !: Beta V 
     32   INTEGER, PUBLIC, PARAMETER ::   jpvor_swf = 10   !: wind stress forcing term 
     33   INTEGER, PUBLIC, PARAMETER ::   jpvor_bfr = 11   !: bottom friction term 
     34 
    635   !!---------------------------------------------------------------------- 
    736   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    837   !! $Header$  
    9    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    10    !!---------------------------------------------------------------------- 
    11    !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    13    USE par_oce      ! ocean parameters 
    14  
    15    IMPLICIT NONE 
    16    PUBLIC 
    17  
    18    INTEGER,PARAMETER :: jplvor = 11     ! Number of vorticity trend terms 
    19  
    20    INTEGER, PARAMETER ::            &  !: vorticity trends index 
    21       jpvorprg = 1,   &  !: Pressure Gradient Trend 
    22       jpvorkeg = 2,   &  !: KE Gradient Trend 
    23       jpvorrvo = 3,   &  !: Relative Vorticity Trend 
    24       jpvorpvo = 4,   &  !: Planetary Vorticity Term Trend 
    25       jpvorldf = 5,   &  !: Horizontal Diffusion Trend 
    26       jpvorzad = 6,   &  !: Vertical Advection Trend 
    27       jpvorzdf = 7,   &  !: Vertical Diffusion Trend 
    28       jpvorspg = 8,   &  !: Surface Pressure Grad. Trend 
    29       jpvorbev = 9,   &  !: Beta V 
    30       jpvorswf =10,   &  !: wind stress forcing term 
    31       jpvorbfr =11       !: bottom friction term 
    32  
    33   !!====================================================================== 
     38   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     39   !!====================================================================== 
    3440END MODULE trdvor_oce 

  • trunk/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r474 r503  
    55   !!                 turbulent closure parameterization 
    66   !!===================================================================== 
     7   !! History :  8.1  ! 00-03 (W.G. Large, J. Chanut) Original code 
     8   !!            8.1  ! 02-06 (J.M. Molines) for real case CLIPPER   
     9   !!            8.2  ! 03-10 (Chanut J.) re-writting 
     10   !!            9.0  ! 05-01 (C. Ethe) Free form, F90 
     11   !!---------------------------------------------------------------------- 
    712#if defined key_zdfkpp   ||   defined key_esopa 
    813   !!---------------------------------------------------------------------- 
    914   !!   'key_zdfkpp'                                             KPP scheme 
    1015   !!---------------------------------------------------------------------- 
     16   !!---------------------------------------------------------------------- 
    1117   !!   zdf_kpp      : update momentum and tracer Kz from a kpp scheme 
    1218   !!   zdf_kpp_init : initialization, namelist read, and parameters control 
    1319   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1520   USE oce             ! ocean dynamics and active tracers  
    1621   USE dom_oce         ! ocean space and time domain 
    … …  
    2833   PRIVATE 
    2934 
    30    !! * Routine accessibility 
    31    PUBLIC zdf_kpp   ! routine called by step.F90 
    32    PUBLIC tra_kpp   ! routine called by step.F90 
    33  
    34    !! * Share Module variables 
    35    LOGICAL, PUBLIC, PARAMETER ::  & 
    36       lk_zdfkpp = .TRUE.          !: KPP vertical mixing flag 
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  
    38       ghats                       ! non-local scalar mixing term (gamma/<ws>o) 
     35   PUBLIC   zdf_kpp   ! routine called by step.F90 
     36   PUBLIC   tra_kpp   ! routine called by step.F90 
     37 
     38   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfkpp = .TRUE.    !: KPP vertical mixing flag 
     39   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ghats   !: non-local scalar mixing term (gamma/<ws>o) 
    3940   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  
    40       wt0                   ,  &  ! surface temperature flux for non local flux 
    41       ws0                   ,  &  ! surface salinity flux for non local flux 
    42       hkpp                        ! boundary layer depht 
    43    !! * Module variables 
     41      wt0                   ,  &  !: surface temperature flux for non local flux 
     42      ws0                   ,  &  !: surface salinity flux for non local flux 
     43      hkpp                        !: boundary layer depht 
     44 
    4445   INTEGER ::                  & !!! ** kpp namelist (namkpp) ** 
    4546      nave  =  1            ,  &  ! = 0/1 flag for horizontal average on avt, avmu, avmv 
    … …  
    148149   !!   OPA 9.0 , LOCEAN-IPSL   (2005) 
    149150   !! $Header$  
    150    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     151   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    151152   !!---------------------------------------------------------------------- 
    152153 
    153154CONTAINS 
    154  
    155155 
    156156   SUBROUTINE zdf_kpp ( kt ) 
    … …  
    184184      !!                update avt, avmu, avmv (before vertical eddy coef.) 
    185185      !! 
    186       !!   References :        
    187       !!         Large W.G., Mc Williams J.C. and Doney S.C.               
     186      !! References : Large W.G., Mc Williams J.C. and Doney S.C.               
    188187      !!         Reviews of Geophysics, 32, 4, November 1994 
    189188      !!         Comments in the code refer to this paper, particularly  
    190189      !!         the equation number. (LMD94, here after) 
    191       !! 
    192       !!   Modifications : 
    193       !!   -------------- 
    194       !!     original  :  00-03 (LARGE W.G.) 
    195       !!     additions :  00-04 (CHANUT J.) 
    196       !!               :  02-06 (MOLINES J.M. for real case CLIPPER) 
    197       !!               :  03-10 (CHANUT J.) 
    198       !! 
    199       !! History : 
    200       !!   8.1  !  00-03  (J. Chanut)  Original code 
    201       !!   8.1  !  00-04  (J.M. Molines) for real case CLIPPER   
    202       !!   9.0  !  05-01  (C. Ethe) Free form, F90 
    203190      !!---------------------------------------------------------------------- 
    204       !! * Modules used 
    205191#if defined  key_zdfddm 
    206192      USE oce     , zviscos => ua,      &  ! temp. array for viscosities use ua as workspace 
    … …  
    211197         &          zdiffut => ta          ! temp. array for diffusivities use sa as workspace 
    212198#endif 
    213  
    214  
    215       !! * arguments 
    216       INTEGER, INTENT( in  ) ::         & 
    217          kt                                ! ocean time step 
    218  
    219       !! * local declarations 
    220       INTEGER ::                        & 
    221          ji, jj, jk                        ! dummy loop indices 
    222       INTEGER ::                        &  ! 
    223          ikbot, jkmax, jkm1, jkp2          ! 
     199      !! 
     200      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
     201      !! 
     202      INTEGER ::   ji, jj, jk              ! dummy loop indices 
     203      INTEGER ::   ikbot, jkmax, jkm1, jkp2   ! 
    224204 
    225205      REAL(wp), DIMENSION(jpi,jpj) ::   & !!! Surface buoyancy forcing, friction velocity 
    … …  
    12511231         IF(ln_ctl) THEN 
    12521232#if defined key_zdfddm 
    1253             CALL prt_ctl(tab3d_1=avt  , clinfo1=' kpp  - t: ', tab3d_2=avs , clinfo2=' s: ', & 
    1254                &         ovlap=1, kdim=jpk) 
     1233            CALL prt_ctl(tab3d_1=avt , clinfo1=' kpp  - t: ', tab3d_2=avs , clinfo2=' s: ', ovlap=1, kdim=jpk) 
    12551234#else 
    1256             CALL prt_ctl(tab3d_1=avt  , clinfo1=' kpp  - t: ', ovlap=1, kdim=jpk) 
    1257 #endif 
    1258             CALL prt_ctl(tab3d_1=avmu  , clinfo1='       u: ', tab3d_2=avmv , clinfo2=' v: ', & 
    1259                &         ovlap=1, kdim=jpk) 
     1235            CALL prt_ctl(tab3d_1=avt , clinfo1=' kpp  - t: ', ovlap=1, kdim=jpk) 
     1236#endif 
     1237            CALL prt_ctl(tab3d_1=avmu, clinfo1='       u: ', tab3d_2=avmv , clinfo2=' v: ', ovlap=1, kdim=jpk) 
    12601238         ENDIF 
    12611239 
    … …  
    13121290         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    13131291!!bug gm jpttdzdf ==> jpttkpp 
    1314          CALL trd_mod(ztrdt, ztrds, jpttdzdf, 'TRA', kt) 
     1292         CALL trd_mod(ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt) 
    13151293      ENDIF 
    13161294 
    1317       IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    1318          CALL prt_ctl(tab3d_1=ta, clinfo1=' kpp  - Ta: ', mask1=tmask, & 
    1319             &         tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra') 
     1295      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' kpp  - Ta: ', mask1=tmask,   & 
     1296         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    13201297      ENDIF 
    13211298 
    … …  
    15941571      END DO 
    15951572#endif 
    1596  
    15971573   END SUBROUTINE zdf_kpp_init 
    15981574 

  • trunk/NEMO/OPA_SRC/opa.F90

    r473 r503  
    6262   USE cpl             ! coupled ocean/atmos.              (cpl_init routine) 
    6363   USE ocfzpt          ! ocean freezing point              (oc_fz_pt routine) 
    64    USE trdicp          ! momentum/tracers trends       (trd_icp_init routine) 
    65    USE trdvor          ! vorticity trends              (trd_vor_init routine) 
    66    USE trdmld          ! tracer mixed layer trends     (trd_mld_init routine) 
     64   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine) 
    6765   USE flxfwb          ! freshwater budget correction  (flx_fwb_init routine) 
    6866   USE flxmod          ! thermohaline forcing of the ocean (flx_init routine) 
    … …  
    280278      CALL zdf_init                             ! Vertical ocean physics 
    281279 
    282       !                                     ! Ocean trends 
    283       ! Control parameters  
    284       IF( lk_trdtra .OR. lk_trdmld )   l_trdtra = .TRUE. 
    285       IF( lk_trddyn .OR. lk_trdvor )   l_trddyn = .TRUE. 
    286  
    287       IF( lk_trddyn .OR. lk_trdtra )   & 
    288          &            CALL trd_icp_init         ! active tracers and/or momentum 
    289  
    290       IF( lk_trdmld ) CALL trd_mld_init         ! mixed layer 
    291  
    292       IF( lk_trdvor ) CALL trd_vor_init         ! vorticity 
     280      CALL trd_mod_init                         ! Mixed-layer/Vorticity/Integral constraints trends 
     281 
    293282 
    294283#if defined key_passivetrc 

  • trunk/NEMO/OPA_SRC/step.F90

    r474 r503  
    102102   USE trdicp          ! Ocean momentum/tracers trends    (trd_wri routine) 
    103103   USE trdmld          ! mixed-layer trends               (trd_mld routine) 
     104   USE trdmld_rst      ! restart for mixed-layer trends 
     105   USE trdmod_oce      ! ocean momentum/tracers trends 
    104106   USE trdvor          ! vorticity budget                 (trd_vor routine) 
    105107   USE diagap          ! hor. mean model-data gap         (dia_gap routine) 
    … …  
    424426                            CALL rst_write  ( kstp )             ! ocean model: restart file output 
    425427         IF( lk_obc     )   CALL obc_rst_wri( kstp )             ! ocean model: open boundary restart file output 
     428         IF( lk_trdmld  )   CALL trd_mld_rst_write( kstp )       ! ocean model: restart file output for trends diagnostics 
    426429                            CALL dia_wri    ( kstp, indic )      ! ocean model: outputs 
    427430 
Note: See TracChangeset for help on using the changeset viewer.