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 12377 for NEMO/trunk/src/OCE/TRD/trdtra.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/OCE/TRD/trdtra.F90

    r10425 r12377  
    4141 
    4242   !! * Substitutions 
    43 #  include "vectopt_loop_substitute.h90" 
     43#  include "do_loop_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6060 
    6161 
    62    SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra ) 
     62   SUBROUTINE trd_tra( kt, Kmm, Krhs, ctype, ktra, ktrd, ptrd, pu, ptra ) 
    6363      !!--------------------------------------------------------------------- 
    6464      !!                  ***  ROUTINE trd_tra  *** 
    … …  
    7777      INTEGER                         , INTENT(in)           ::   ktra    ! tracer index 
    7878      INTEGER                         , INTENT(in)           ::   ktrd    ! tracer trend index 
     79      INTEGER                         , INTENT(in)           ::   Kmm, Krhs ! time level indices 
    7980      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::   ptrd    ! tracer trend  or flux 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pun     ! now velocity  
     81      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pu      ! now velocity  
    8182      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable 
    8283      ! 
    … …  
    9495         SELECT CASE( ktrd ) 
    9596         !                            ! advection: transform the advective flux into a trend 
    96          CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx )  
    97          CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty )  
    98          CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  )  
     97         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm )  
     98         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'Y', trdty, Kmm )  
     99         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'Z', trdt, Kmm ) 
    99100         CASE( jptra_bbc,    &        ! qsr, bbc: on temperature only, send to trd_tra_mng 
    100101            &  jptra_qsr )   ;   trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    101102                                 ztrds(:,:,:) = 0._wp 
    102                                  CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 
     103                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm ) 
    103104 !!gm Gurvan, verify the jptra_evd trend please ! 
    104105         CASE( jptra_evd )   ;   avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    … …  
    114115         !                            ! advection: transform the advective flux into a trend 
    115116         !                            !            and send T & S trends to trd_tra_mng 
    116          CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'X'  , ztrds )  
    117                                   CALL trd_tra_mng( trdtx, ztrds, ktrd, kt   ) 
    118          CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Y'  , ztrds )  
    119                                   CALL trd_tra_mng( trdty, ztrds, ktrd, kt   ) 
    120          CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Z'  , ztrds )  
    121                                   CALL trd_tra_mng( trdt , ztrds, ktrd, kt   ) 
     117         CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pu  , ptra, 'X'  , ztrds, Kmm )  
     118                                  CALL trd_tra_mng( trdtx, ztrds, ktrd, kt, Kmm   ) 
     119         CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pu  , ptra, 'Y'  , ztrds, Kmm )  
     120                                  CALL trd_tra_mng( trdty, ztrds, ktrd, kt, Kmm   ) 
     121         CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pu  , ptra, 'Z'  , ztrds, Kmm )  
     122                                  CALL trd_tra_mng( trdt , ztrds, ktrd, kt, Kmm   ) 
    122123         CASE( jptra_zdfp )           ! diagnose the "PURE" Kz trend (here: just before the swap) 
    123124            !                         ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" 
    … …  
    127128            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
    128129            DO jk = 2, jpk 
    129                zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
    130                zws(:,:,jk) = avs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
     130               zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
     131               zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
    131132            END DO 
    132133            ! 
    133134            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
    134135            DO jk = 1, jpkm1 
    135                ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk) 
    136                ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk)  
     136               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 
     137               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm)  
    137138            END DO 
    138             CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )   
     139            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt, Kmm )   
    139140            ! 
    140141            !                         ! Also calculate EVD trend at this point.  
    141142            zwt(:,:,:) = 0._wp   ;   zws(:,:,:) = 0._wp            ! vertical diffusive fluxes 
    142143            DO jk = 2, jpk 
    143                zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
    144                zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
     144               zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
     145               zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
    145146            END DO 
    146147            ! 
    147148            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
    148149            DO jk = 1, jpkm1 
    149                ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk) 
    150                ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk)  
     150               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 
     151               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm)  
    151152            END DO 
    152             CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )   
     153            CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt, Kmm )   
    153154            ! 
    154155            DEALLOCATE( zwt, zws, ztrdt ) 
    … …  
    156157         CASE DEFAULT                 ! other trends: mask and send T & S trends to trd_tra_mng 
    157158            ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    158             CALL trd_tra_mng( trdt, ztrds, ktrd, kt )   
     159            CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm )   
    159160         END SELECT 
    160161      ENDIF 
    … …  
    164165         SELECT CASE( ktrd ) 
    165166         !                            ! advection: transform the advective flux into a masked trend 
    166          CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds )  
    167          CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds )  
    168          CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds )  
     167         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm )  
     168         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'Y', ztrds, Kmm )  
     169         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'Z', ztrds, Kmm )  
    169170         CASE DEFAULT                 ! other trends: just masked  
    170171                                 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    171172         END SELECT 
    172173         !                            ! send trend to trd_trc 
    173          CALL trd_trc( ztrds, ktra, ktrd, kt )  
     174         CALL trd_trc( ztrds, ktra, ktrd, kt, Kmm )  
    174175         ! 
    175176      ENDIF 
    … …  
    178179 
    179180 
    180    SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd ) 
     181   SUBROUTINE trd_tra_adv( pf, pu, pt, cdir, ptrd, Kmm ) 
    181182      !!--------------------------------------------------------------------- 
    182183      !!                  ***  ROUTINE trd_tra_adv  *** 
    … …  
    191192      !!---------------------------------------------------------------------- 
    192193      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pf      ! advective flux in one direction 
    193       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pun     ! now velocity   in one direction 
    194       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptn     ! now or before tracer  
     194      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu      ! now velocity   in one direction 
     195      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt      ! now or before tracer  
    195196      CHARACTER(len=1)                , INTENT(in   ) ::   cdir    ! X/Y/Z direction 
    196197      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   ptrd    ! advective trend in one direction 
     198      INTEGER,  INTENT(in)                            ::   Kmm     ! time level index 
    197199      ! 
    198200      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    211213      ptrd(:,:,jpk) = 0._wp 
    212214      ! 
    213       DO jk = 1, jpkm1         ! advective trend 
    214          DO jj = 2, jpjm1 
    215             DO ji = fs_2, fs_jpim1   ! vector opt. 
    216                ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        & 
    217                  &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   & 
    218                  &              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    219             END DO 
    220          END DO 
    221       END DO 
     215      DO_3D_00_00( 1, jpkm1 ) 
     216         ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        & 
     217           &                  - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk)  )   & 
     218           &              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     219      END_3D 
    222220      ! 
    223221   END SUBROUTINE trd_tra_adv 
    224222 
    225223 
    226    SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt ) 
     224   SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt, Kmm ) 
    227225      !!--------------------------------------------------------------------- 
    228226      !!                  ***  ROUTINE trd_tra_mng  *** 
    … …  
    236234      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    237235      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     236      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    238237      !!---------------------------------------------------------------------- 
    239238 
    … …  
    243242 
    244243      !                   ! 3D output of tracers trends using IOM interface 
    245       IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) 
     244      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt, Kmm ) 
    246245 
    247246      !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    248       IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt ) 
     247      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt, Kmm ) 
    249248 
    250249      !                   ! Potential ENergy trends 
    251       IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt ) 
     250      IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt, Kmm ) 
    252251 
    253252      !                   ! Mixed layer trends for active tracers 
    … …  
    290289 
    291290 
    292    SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt ) 
     291   SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt, Kmm ) 
    293292      !!--------------------------------------------------------------------- 
    294293      !!                  ***  ROUTINE trd_tra_iom  *** 
    … …  
    300299      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    301300      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     301      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    302302      !! 
    303303      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    … …  
    326326                                  IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface 
    327327                                     ALLOCATE( z2dx(jpi,jpj), z2dy(jpi,jpj) ) 
    328                                      z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 
    329                                      z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 
     328                                     z2dx(:,:) = ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) / e3t(:,:,1,Kmm) 
     329                                     z2dy(:,:) = ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) / e3t(:,:,1,Kmm) 
    330330                                     CALL iom_put( "ttrd_sad", z2dx ) 
    331331                                     CALL iom_put( "strd_sad", z2dy ) 
Note: See TracChangeset for help on using the changeset viewer.