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/TRA/tramle.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/TRA/tramle.F90

    r11536 r12377  
    4848 
    4949   !! * Substitutions 
    50 #  include "vectopt_loop_substitute.h90" 
     50#  include "do_loop_substitute.h90" 
    5151   !!---------------------------------------------------------------------- 
    5252   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    5656CONTAINS 
    5757 
    58    SUBROUTINE tra_mle_trp( kt, kit000, pu, pv, pw, cdtype ) 
     58   SUBROUTINE tra_mle_trp( kt, kit000, pu, pv, pw, cdtype, Kmm ) 
    5959      !!---------------------------------------------------------------------- 
    6060      !!                  ***  ROUTINE tra_mle_trp  *** 
    … …  
    7171      !!                p.n = p.n + z._mle 
    7272      !! 
    73       !! ** Action  : - (pun,pvn,pwn) increased by the mle transport 
     73      !! ** Action  : - (pu,pv,pw) increased by the mle transport 
    7474      !!                CAUTION, the transport is not updated at the last line/raw 
    7575      !!                         this may be a problem for some advection schemes 
    … …  
    8080      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    8181      INTEGER                         , INTENT(in   ) ::   kit000     ! first time step index 
     82      INTEGER                         , INTENT(in   ) ::   Kmm        ! ocean time level index 
    8283      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    8384      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components 
    … …  
    9899      inml_mle(:,:) = mbkt(:,:) + 1                    ! init. to number of ocean w-level (T-level + 1) 
    99100      IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m 
    100          DO jk = jpkm1, nlb10, -1                      ! from the bottom to nlb10 (10m) 
    101             DO jj = 1, jpj 
    102                DO ji = 1, jpi                          ! index of the w-level at the ML based 
    103                   IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer 
    104                END DO 
    105             END DO 
    106          END DO 
     101         DO_3DS_11_11( jpkm1, nlb10, -1 ) 
     102            IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer 
     103         END_3D 
    107104      ENDIF 
    108105      ikmax = MIN( MAXVAL( inml_mle(:,:) ), jpkm1 )                  ! max level of the computation 
    … …  
    112109      zbm (:,:) = 0._wp 
    113110      zn2 (:,:) = 0._wp 
    114       DO jk = 1, ikmax                                 ! MLD and mean buoyancy and N2 over the mixed layer 
    115          DO jj = 1, jpj 
    116             DO ji = 1, jpi 
    117                zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
    118                zmld(ji,jj) = zmld(ji,jj) + zc 
    119                zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0 
    120                zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp 
    121             END DO 
    122          END DO 
    123       END DO 
     111      DO_3D_11_11( 1, ikmax ) 
     112         zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
     113         zmld(ji,jj) = zmld(ji,jj) + zc 
     114         zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0 
     115         zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp 
     116      END_3D 
    124117 
    125118      SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
    126119      CASE ( 0 )                                               != min of the 2 neighbour MLDs 
    127          DO jj = 1, jpjm1 
    128             DO ji = 1, fs_jpim1   ! vector opt. 
    129                zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 
    130                zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 
    131             END DO 
    132          END DO 
     120         DO_2D_10_10 
     121            zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 
     122            zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 
     123         END_2D 
    133124      CASE ( 1 )                                               != average of the 2 neighbour MLDs 
    134          DO jj = 1, jpjm1 
    135             DO ji = 1, fs_jpim1   ! vector opt. 
    136                zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 
    137                zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 
    138             END DO 
    139          END DO 
     125         DO_2D_10_10 
     126            zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 
     127            zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 
     128         END_2D 
    140129      CASE ( 2 )                                               != max of the 2 neighbour MLDs 
    141          DO jj = 1, jpjm1 
    142             DO ji = 1, fs_jpim1   ! vector opt. 
    143                zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 
    144                zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) 
    145             END DO 
    146          END DO 
     130         DO_2D_10_10 
     131            zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 
     132            zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) 
     133         END_2D 
    147134      END SELECT 
    148135      !                                                ! convert density into buoyancy 
    149       zbm(:,:) = + grav * zbm(:,:) / MAX( e3t_n(:,:,1), zmld(:,:) ) 
     136      zbm(:,:) = + grav * zbm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 
    150137      ! 
    151138      ! 
    … …  
    158145      ! 
    159146      IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
    160          DO jj = 1, jpjm1 
    161             DO ji = 1, fs_jpim1   ! vector opt. 
    162                zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & 
    163                   &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
    164                   &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   ) 
    165                   ! 
    166                zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            & 
    167                   &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   & 
    168                   &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   ) 
    169             END DO 
    170          END DO 
     147         DO_2D_10_10 
     148            zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & 
     149               &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
     150               &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   ) 
     151               ! 
     152            zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            & 
     153               &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   & 
     154               &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   ) 
     155         END_2D 
    171156         ! 
    172157      ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
    173          DO jj = 1, jpjm1 
    174             DO ji = 1, fs_jpim1   ! vector opt. 
    175                zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & 
    176                   &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 
    177                   ! 
    178                zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               & 
    179                   &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 
    180             END DO 
    181          END DO 
     158         DO_2D_10_10 
     159            zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & 
     160               &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 
     161               ! 
     162            zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               & 
     163               &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 
     164         END_2D 
    182165      ENDIF 
    183166      ! 
    184167      IF( nn_conv == 1 ) THEN              ! No MLE in case of convection 
    185          DO jj = 1, jpjm1 
    186             DO ji = 1, fs_jpim1   ! vector opt. 
    187                IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp 
    188                IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp 
    189             END DO 
    190          END DO 
     168         DO_2D_10_10 
     169            IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp 
     170            IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp 
     171         END_2D 
    191172      ENDIF 
    192173      ! 
    193174      !                                      !==  structure function value at uw- and vw-points  ==! 
    194       DO jj = 1, jpjm1 
    195          DO ji = 1, fs_jpim1   ! vector opt. 
    196             zhu(ji,jj) = 1._wp / zhu(ji,jj)                   ! hu --> 1/hu 
    197             zhv(ji,jj) = 1._wp / zhv(ji,jj) 
    198          END DO 
    199       END DO 
     175      DO_2D_10_10 
     176         zhu(ji,jj) = 1._wp / zhu(ji,jj)                   ! hu --> 1/hu 
     177         zhv(ji,jj) = 1._wp / zhv(ji,jj) 
     178      END_2D 
    200179      ! 
    201180      zpsi_uw(:,:,:) = 0._wp 
    202181      zpsi_vw(:,:,:) = 0._wp 
    203182      ! 
    204       DO jk = 2, ikmax                                ! start from 2 : surface value = 0 
    205          DO jj = 1, jpjm1 
    206             DO ji = 1, fs_jpim1   ! vector opt. 
    207                zcuw = 1._wp - ( gdepw_n(ji+1,jj,jk) + gdepw_n(ji,jj,jk) ) * zhu(ji,jj) 
    208                zcvw = 1._wp - ( gdepw_n(ji,jj+1,jk) + gdepw_n(ji,jj,jk) ) * zhv(ji,jj) 
    209                zcuw = zcuw * zcuw 
    210                zcvw = zcvw * zcvw 
    211                zmuw = MAX(  0._wp , ( 1._wp - zcuw ) * ( 1._wp + r5_21 * zcuw )  ) 
    212                zmvw = MAX(  0._wp , ( 1._wp - zcvw ) * ( 1._wp + r5_21 * zcvw )  ) 
    213                ! 
    214                zpsi_uw(ji,jj,jk) = zpsim_u(ji,jj) * zmuw * umask(ji,jj,jk) 
    215                zpsi_vw(ji,jj,jk) = zpsim_v(ji,jj) * zmvw * vmask(ji,jj,jk) 
    216             END DO 
    217          END DO 
    218       END DO 
     183      DO_3D_10_10( 2, ikmax ) 
     184         zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) 
     185         zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj) 
     186         zcuw = zcuw * zcuw 
     187         zcvw = zcvw * zcvw 
     188         zmuw = MAX(  0._wp , ( 1._wp - zcuw ) * ( 1._wp + r5_21 * zcuw )  ) 
     189         zmvw = MAX(  0._wp , ( 1._wp - zcvw ) * ( 1._wp + r5_21 * zcvw )  ) 
     190         ! 
     191         zpsi_uw(ji,jj,jk) = zpsim_u(ji,jj) * zmuw * umask(ji,jj,jk) 
     192         zpsi_vw(ji,jj,jk) = zpsim_v(ji,jj) * zmvw * vmask(ji,jj,jk) 
     193      END_3D 
    219194      ! 
    220195      !                                      !==  transport increased by the MLE induced transport ==! 
    221196      DO jk = 1, ikmax 
    222          DO jj = 1, jpjm1                          ! CAUTION pu,pv must be defined at row/column i=1 / j=1 
    223             DO ji = 1, fs_jpim1   ! vector opt. 
    224                pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
    225                pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
    226             END DO 
    227          END DO 
    228          DO jj = 2, jpjm1 
    229             DO ji = fs_2, fs_jpim1   ! vector opt. 
    230                pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   & 
    231                   &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) 
    232             END DO 
    233          END DO 
     197         DO_2D_10_10 
     198            pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
     199            pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
     200         END_2D 
     201         DO_2D_00_00 
     202            pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   & 
     203               &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) 
     204         END_2D 
    234205      END DO 
    235206 
    … …  
    266237      !!---------------------------------------------------------------------- 
    267238 
    268       REWIND( numnam_ref )              ! Namelist namtra_mle in reference namelist : Tracer advection scheme 
    269239      READ  ( numnam_ref, namtra_mle, IOSTAT = ios, ERR = 901) 
    270240901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_mle in reference namelist' ) 
    271241 
    272       REWIND( numnam_cfg )              ! Namelist namtra_mle in configuration namelist : Tracer advection scheme 
    273242      READ  ( numnam_cfg, namtra_mle, IOSTAT = ios, ERR = 902 ) 
    274243902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_mle in configuration namelist' ) 
    … …  
    313282            IF( ierr /= 0 )   CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 
    314283            z1_t2 = 1._wp / ( rn_time * rn_time ) 
    315             DO jj = 2, jpj                           ! "coriolis+ time^-1" at u- & v-points 
    316                DO ji = fs_2, jpi   ! vector opt. 
    317                   zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 
    318                   zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp 
    319                   rfu(ji,jj) = SQRT(  zfu * zfu + z1_t2 ) 
    320                   rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 ) 
    321                END DO 
    322             END DO 
     284            DO_2D_01_01 
     285               zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 
     286               zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp 
     287               rfu(ji,jj) = SQRT(  zfu * zfu + z1_t2 ) 
     288               rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 ) 
     289            END_2D 
    323290            CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1. , rfv, 'V', 1. ) 
    324291            ! 
Note: See TracChangeset for help on using the changeset viewer.