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/trdglo.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/trdglo.F90

    r10425 r12377  
    5151 
    5252   !! * Substitutions 
    53 #  include "vectopt_loop_substitute.h90" 
     53#  include "do_loop_substitute.h90" 
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5959CONTAINS 
    6060 
    61    SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt ) 
     61   SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt, Kmm ) 
    6262      !!--------------------------------------------------------------------- 
    6363      !!                  ***  ROUTINE trd_glo  *** 
     
    7272      CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type (='DYN'/'TRA') 
    7373      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     74      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    7475      !! 
    7576      INTEGER ::   ji, jj, jk      ! dummy loop indices 
     
    8485         ! 
    8586         CASE( 'TRA' )          !==  Tracers (T & S)  ==! 
    86             DO jk = 1, jpkm1       ! global sum of mask volume trend and trend*T (including interior mask) 
    87                DO jj = 1, jpj 
    88                   DO ji = 1, jpi         
    89                      zvm = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    90                      zvt = ptrdx(ji,jj,jk) * zvm 
    91                      zvs = ptrdy(ji,jj,jk) * zvm 
    92                      tmo(ktrd) = tmo(ktrd) + zvt    
    93                      smo(ktrd) = smo(ktrd) + zvs 
    94                      t2 (ktrd) = t2(ktrd)  + zvt * tsn(ji,jj,jk,jp_tem) 
    95                      s2 (ktrd) = s2(ktrd)  + zvs * tsn(ji,jj,jk,jp_sal) 
    96                   END DO 
    97                END DO 
    98             END DO 
     87            DO_3D_11_11( 1, jpkm1 ) 
     88               zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     89               zvt = ptrdx(ji,jj,jk) * zvm 
     90               zvs = ptrdy(ji,jj,jk) * zvm 
     91               tmo(ktrd) = tmo(ktrd) + zvt    
     92               smo(ktrd) = smo(ktrd) + zvs 
     93               t2 (ktrd) = t2(ktrd)  + zvt * ts(ji,jj,jk,jp_tem,Kmm) 
     94               s2 (ktrd) = s2(ktrd)  + zvs * ts(ji,jj,jk,jp_sal,Kmm) 
     95            END_3D 
    9996            !                       ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface 
    10097            IF( ln_linssh .AND. ktrd == jptra_zad ) THEN   
    101                tmo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:) ) 
    102                smo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  ) 
    103                t2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:)  ) 
    104                s2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  ) 
     98               tmo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 
     99               smo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:)  ) 
     100               t2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:)  ) 
     101               s2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:)  ) 
    105102            ENDIF 
    106103            ! 
     
    117114            ! 
    118115         CASE( 'DYN' )          !==  Momentum and KE  ==!         
    119             DO jk = 1, jpkm1 
    120                DO jj = 1, jpjm1 
    121                   DO ji = 1, jpim1 
    122                      zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    123                         &                                     * e1e2u  (ji,jj) * e3u_n(ji,jj,jk) 
    124                      zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    125                         &                                     * e1e2v  (ji,jj) * e3u_n(ji,jj,jk) 
    126                      umo(ktrd) = umo(ktrd) + zvt 
    127                      vmo(ktrd) = vmo(ktrd) + zvs 
    128                      hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * zvt + vn(ji,jj,jk) * zvs 
    129                   END DO 
    130                END DO 
    131             END DO 
     116            DO_3D_10_10( 1, jpkm1 ) 
     117               zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
     118                  &                                     * e1e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) 
     119               zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
     120                  &                                     * e1e2v  (ji,jj) * e3u(ji,jj,jk,Kmm) 
     121               umo(ktrd) = umo(ktrd) + zvt 
     122               vmo(ktrd) = vmo(ktrd) + zvs 
     123               hke(ktrd) = hke(ktrd) + uu(ji,jj,jk,Kmm) * zvt + vv(ji,jj,jk,Kmm) * zvs 
     124            END_3D 
    132125            !                  
    133126            IF( ktrd == jpdyn_zdf ) THEN      ! zdf trend: compute separately the surface forcing trend 
    134127               z1_2rau0 = 0.5_wp / rau0 
    135                DO jj = 1, jpjm1 
    136                   DO ji = 1, jpim1 
    137                      zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    138                         &                                                     * z1_2rau0       * e1e2u(ji,jj) 
    139                      zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    140                         &                                                     * z1_2rau0       * e1e2v(ji,jj) 
    141                      umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
    142                      vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 
    143                      hke(jpdyn_tau) = hke(jpdyn_tau) + un(ji,jj,1) * zvt + vn(ji,jj,1) * zvs 
    144                   END DO 
    145                END DO 
     128               DO_2D_10_10 
     129                  zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
     130                     &                                                     * z1_2rau0       * e1e2u(ji,jj) 
     131                  zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
     132                     &                                                     * z1_2rau0       * e1e2v(ji,jj) 
     133                  umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
     134                  vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 
     135                  hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs 
     136               END_2D 
    146137            ENDIF 
    147138            !                        
     
    155146!                        ikbu = mbku(ji,jj)                  ! deepest ocean u- & v-levels 
    156147!                        ikbv = mbkv(ji,jj) 
    157 !                        zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * un(ji,jj,ikbu) * e1e2u(ji,jj) 
    158 !                        zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vn(ji,jj,ikbv) * e1e2v(ji,jj) 
     148!                        zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu(ji,jj,ikbu,Kmm) * e1e2u(ji,jj) 
     149!                        zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv(ji,jj,ikbv,Kmm) * e1e2v(ji,jj) 
    159150!                        umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 
    160151!                        vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs 
    161 !                        hke(jpdyn_bfri) = hke(jpdyn_bfri) + un(ji,jj,ikbu) * zvt + vn(ji,jj,ikbv) * zvs 
     152!                        hke(jpdyn_bfri) = hke(jpdyn_bfri) + uu(ji,jj,ikbu,Kmm) * zvt + vv(ji,jj,ikbv,Kmm) * zvs 
    162153!                     END DO 
    163154!                  END DO 
     
    183174 
    184175 
    185    SUBROUTINE glo_dyn_wri( kt ) 
     176   SUBROUTINE glo_dyn_wri( kt, Kmm ) 
    186177      !!--------------------------------------------------------------------- 
    187178      !!                  ***  ROUTINE glo_dyn_wri  *** 
     
    190181      !!---------------------------------------------------------------------- 
    191182      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     183      INTEGER, INTENT(in) ::   Kmm  ! time level index 
    192184      ! 
    193185      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    209201         zkepe(:,:,:) = 0._wp 
    210202    
    211          CALL eos( tsn, rhd, rhop )       ! now potential density 
     203         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop )       ! now potential density 
    212204 
    213205         zcof = 0.5_wp / rau0             ! Density flux at w-point 
    214206         zkz(:,:,1) = 0._wp 
    215207         DO jk = 2, jpk 
    216             zkz(:,:,jk) = zcof * e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 
     208            zkz(:,:,jk) = zcof * e1e2t(:,:) * ww(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 
    217209         END DO 
    218210          
    219211         zcof   = 0.5_wp / rau0           ! Density flux at u and v-points 
    220          DO jk = 1, jpkm1 
    221             DO jj = 1, jpjm1 
    222                DO ji = 1, jpim1 
    223                   zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
    224                   zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
    225                END DO 
    226             END DO 
    227          END DO 
     212         DO_3D_10_10( 1, jpkm1 ) 
     213            zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
     214            zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
     215         END_3D 
    228216          
    229          DO jk = 1, jpkm1                 ! Density flux divergence at t-point 
    230             DO jj = 2, jpjm1 
    231                DO ji = 2, jpim1 
    232                   zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
    233                      &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
    234                      &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           & 
    235                      &              / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    236                END DO 
    237             END DO 
    238          END DO 
     217         DO_3D_00_00( 1, jpkm1 ) 
     218            zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
     219               &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
     220               &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           & 
     221               &              / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     222         END_3D 
    239223 
    240224         ! I.2 Basin averaged kinetic energy trend 
     
    242226         peke = 0._wp 
    243227         DO jk = 1, jpkm1 
    244             peke = peke + SUM( zkepe(:,:,jk) * gdept_n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) ) 
     228            peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) * e3t(:,:,jk,Kmm) ) 
    245229         END DO 
    246230         peke = grav * peke 
     
    506490 
    507491 
    508    SUBROUTINE trd_glo_init 
     492   SUBROUTINE trd_glo_init( Kmm ) 
    509493      !!--------------------------------------------------------------------- 
    510494      !!                  ***  ROUTINE trd_glo_init  *** 
     
    512496      !! ** Purpose :   Read the namtrd namelist 
    513497      !!---------------------------------------------------------------------- 
     498      INTEGER, INTENT(in) ::   Kmm   ! time level index 
    514499      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    515500      !!---------------------------------------------------------------------- 
     
    524509      tvolt = 0._wp 
    525510      DO jk = 1, jpkm1 
    526          tvolt = tvolt + SUM( e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
     511         tvolt = tvolt + SUM( e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * tmask_i(:,:) ) 
    527512      END DO 
    528513      CALL mpp_sum( 'trdglo', tvolt )   ! sum over the global domain 
     
    538523      tvolv = 0._wp 
    539524 
    540       DO jk = 1, jpk 
    541          DO jj = 2, jpjm1 
    542             DO ji = fs_2, fs_jpim1   ! vector opt. 
    543                tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u_n(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    544                tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v_n(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    545             END DO 
    546          END DO 
    547       END DO 
     525      DO_3D_00_00( 1, jpk ) 
     526         tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
     527         tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
     528      END_3D 
    548529      CALL mpp_sum( 'trdglo', tvolu )   ! sums over the global domain 
    549530      CALL mpp_sum( 'trdglo', tvolv ) 
Note: See TracChangeset for help on using the changeset viewer.