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/DIA/diaar5.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/DIA/diaar5.F90

    r12276 r12377  
    3939       
    4040   !! * Substitutions 
    41 #  include "vectopt_loop_substitute.h90" 
     41#  include "do_loop_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6262 
    6363 
    64    SUBROUTINE dia_ar5( kt ) 
     64   SUBROUTINE dia_ar5( kt, Kmm ) 
    6565      !!---------------------------------------------------------------------- 
    6666      !!                    ***  ROUTINE dia_ar5  *** 
    … …  
    7070      ! 
    7171      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     72      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index 
    7273      ! 
    7374      INTEGER  ::   ji, jj, jk, iks, ikb                      ! dummy loop arguments 
    … …  
    8990         ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 
    9091         ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 
    91          zarea_ssh(:,:) = area(:,:) * sshn(:,:) 
     92         zarea_ssh(:,:) = area(:,:) * ssh(:,:,Kmm) 
    9293      ENDIF 
    9394      ! 
    … …  
    99100         zrhd(:,:,jpk) = 0._wp        ! ocean volume ; rhd is used as workspace 
    100101         DO jk = 1, jpkm1 
    101             zrhd(:,:,jk) = area(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
     102            zrhd(:,:,jk) = area(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    102103         END DO 
    103104         CALL iom_put( 'volcello'  , zrhd(:,:,:)  )  ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 
    104          CALL iom_put( 'masscello' , rau0 * e3t_n(:,:,:) * tmask(:,:,:) )  ! ocean mass 
     105         CALL iom_put( 'masscello' , rau0 * e3t(:,:,:,Kmm) * tmask(:,:,:) )  ! ocean mass 
    105106      ENDIF  
    106107      ! 
    107108      IF( iom_use( 'e3tb' ) )  THEN    ! bottom layer thickness 
    108          DO jj = 1, jpj 
    109             DO ji = 1, jpi 
    110                ikb = mbkt(ji,jj) 
    111                z2d(ji,jj) = e3t_n(ji,jj,ikb) 
    112             END DO 
    113          END DO 
     109         DO_2D_11_11 
     110            ikb = mbkt(ji,jj) 
     111            z2d(ji,jj) = e3t(ji,jj,ikb,Kmm) 
     112         END_2D 
    114113         CALL iom_put( 'e3tb', z2d ) 
    115114      ENDIF  
    … …  
    122121         CALL iom_put( 'voltot', zvol               ) 
    123122         CALL iom_put( 'sshtot', zvolssh / area_tot ) 
    124          CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 
     123         CALL iom_put( 'sshdyn', ssh(:,:,Kmm) - (zvolssh / area_tot) ) 
    125124         ! 
    126125      ENDIF 
    … …  
    128127      IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) THEN     
    129128         !                      
    130          ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
     129         ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm)                    ! thermosteric ssh 
    131130         ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    132          CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity 
     131         CALL eos( ztsn, zrhd, gdept(:,:,:,Kmm) )                       ! now in situ density using initial salinity 
    133132         ! 
    134133         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    135134         DO jk = 1, jpkm1 
    136             zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
     135            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 
    137136         END DO 
    138137         IF( ln_linssh ) THEN 
    … …  
    141140                  DO jj = 1, jpj 
    142141                     iks = mikt(ji,jj) 
    143                      zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,iks) + riceload(ji,jj) 
     142                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 
    144143                  END DO 
    145144               END DO 
    146145            ELSE 
    147                zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     146               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 
    148147            END IF 
    149148!!gm 
    … …  
    157156       
    158157         !                                         ! steric sea surface height 
    159          CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density 
     158         CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) )                 ! now in situ and potential density 
    160159         zrhop(:,:,jpk) = 0._wp 
    161160         CALL iom_put( 'rhop', zrhop ) 
    … …  
    163162         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    164163         DO jk = 1, jpkm1 
    165             zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
     164            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 
    166165         END DO 
    167166         IF( ln_linssh ) THEN 
    … …  
    170169                  DO jj = 1,jpj 
    171170                     iks = mikt(ji,jj) 
    172                      zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,iks) + riceload(ji,jj) 
     171                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 
    173172                  END DO 
    174173               END DO 
    175174            ELSE 
    176                zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     175               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 
    177176            END IF 
    178177         END IF 
    … …  
    183182         !                                         ! ocean bottom pressure 
    184183         zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
    185          zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 
     184         zbotpres(:,:) = zztmp * ( zbotpres(:,:) + ssh(:,:,Kmm) + thick0(:,:) ) 
    186185         CALL iom_put( 'botpres', zbotpres ) 
    187186         ! 
    … …  
    191190          !                                         ! Mean density anomalie, temperature and salinity 
    192191          ztsn(:,:,:,:) = 0._wp                    ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 
    193           DO jk = 1, jpkm1 
    194              DO jj = 1, jpj 
    195                 DO ji = 1, jpi 
    196                    zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 
    197                    ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * tsn(ji,jj,jk,jp_tem) 
    198                    ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * tsn(ji,jj,jk,jp_sal) 
    199                 ENDDO 
    200              ENDDO 
    201           ENDDO 
     192          DO_3D_11_11( 1, jpkm1 ) 
     193             zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm) 
     194             ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 
     195             ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) 
     196          END_3D 
    202197 
    203198          IF( ln_linssh ) THEN 
    … …  
    206201                  DO jj = 1, jpj 
    207202                     iks = mikt(ji,jj) 
    208                      ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * tsn(ji,jj,iks,jp_tem)  
    209                      ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * tsn(ji,jj,iks,jp_sal)  
     203                     ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm)  
     204                     ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm)  
    210205                  END DO 
    211206               END DO 
    212207            ELSE 
    213                ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * tsn(:,:,1,jp_tem)  
    214                ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * tsn(:,:,1,jp_sal)  
     208               ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm)  
     209               ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm)  
    215210            END IF 
    216211         ENDIF 
    … …  
    233228            ztpot(:,:,jpk) = 0._wp 
    234229            DO jk = 1, jpkm1 
    235                ztpot(:,:,jk) = eos_pt_from_ct( tsn(:,:,jk,jp_tem), tsn(:,:,jk,jp_sal) ) 
     230               ztpot(:,:,jk) = eos_pt_from_ct( ts(:,:,jk,jp_tem,Kmm), ts(:,:,jk,jp_sal,Kmm) ) 
    236231            END DO 
    237232            ! 
    … …  
    242237               z2d(:,:) = 0._wp 
    243238               DO jk = 1, jpkm1 
    244                  z2d(:,:) = z2d(:,:) + area(:,:) * e3t_n(:,:,jk) * ztpot(:,:,jk) 
     239                 z2d(:,:) = z2d(:,:) + area(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 
    245240               END DO 
    246241               ztemp = glob_sum( 'diaar5', z2d(:,:)  )  
    … …  
    255250             IF( iom_use( 'tosmint_pot') ) THEN 
    256251               z2d(:,:) = 0._wp 
    257                DO jk = 1, jpkm1 
    258                   DO jj = 1, jpj 
    259                      DO ji = 1, jpi   ! vector opt. 
    260                         z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) *  ztpot(ji,jj,jk) 
    261                      END DO 
    262                   END DO 
    263                END DO 
     252               DO_3D_11_11( 1, jpkm1 ) 
     253                  z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t(ji,jj,jk,Kmm) *  ztpot(ji,jj,jk) 
     254               END_3D 
    264255               CALL iom_put( 'tosmint_pot', z2d )  
    265256            ENDIF 
    … …  
    268259      ELSE        
    269260         IF( iom_use('ssttot') ) THEN   ! Output sst in case we use EOS-80 
    270             zsst  = glob_sum( 'diaar5', area(:,:) * tsn(:,:,1,jp_tem) ) 
     261            zsst  = glob_sum( 'diaar5', area(:,:) * ts(:,:,1,jp_tem,Kmm) ) 
    271262            CALL iom_put('ssttot', zsst / area_tot ) 
    272263         ENDIF 
    … …  
    280271         zpe(:,:) = 0._wp 
    281272         IF( ln_zdfddm ) THEN 
    282             DO jk = 2, jpk 
    283                DO jj = 1, jpj 
    284                   DO ji = 1, jpi 
    285                      IF( rn2(ji,jj,jk) > 0._wp ) THEN 
    286                         zrw = ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk) 
    287                         ! 
    288                         zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
    289                         zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
    290                         ! 
    291                         zpe(ji, jj) = zpe(ji,jj)   & 
    292                            &        -  grav * (  avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
    293                            &                   - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
    294                      ENDIF 
    295                   END DO 
    296                END DO 
    297              END DO 
     273            DO_3D_11_11( 2, jpk ) 
     274               IF( rn2(ji,jj,jk) > 0._wp ) THEN 
     275                  zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) 
     276                  ! 
     277                  zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
     278                  zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
     279                  ! 
     280                  zpe(ji, jj) = zpe(ji,jj)   & 
     281                     &        -  grav * (  avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) )  & 
     282                     &                   - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) ) 
     283               ENDIF 
     284            END_3D 
    298285          ELSE 
    299             DO jk = 1, jpk 
    300                DO ji = 1, jpi 
    301                   DO jj = 1, jpj 
    302                      zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rau0 * e3w_n(ji,jj,jk) 
    303                   END DO 
    304                END DO 
    305             END DO 
     286            DO_3D_11_11( 1, jpk ) 
     287               zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rau0 * e3w(ji,jj,jk,Kmm) 
     288            END_3D 
    306289         ENDIF 
    307290          CALL iom_put( 'tnpeo', zpe ) 
    … …  
    320303 
    321304 
    322    SUBROUTINE dia_ar5_hst( ktra, cptr, pua, pva )  
     305   SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx )  
    323306      !!---------------------------------------------------------------------- 
    324307      !!                    ***  ROUTINE dia_ar5_htr *** 
    … …  
    329312      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
    330313      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf' 
    331       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pua   ! 3D input array of advection/diffusion 
    332       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
     314      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: puflx  ! u-flux of advection/diffusion 
     315      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx  ! v-flux of advection/diffusion 
    333316      ! 
    334317      INTEGER    ::  ji, jj, jk 
    … …  
    336319 
    337320     
    338       z2d(:,:) = pua(:,:,1)  
    339       DO jk = 1, jpkm1 
    340          DO jj = 2, jpjm1 
    341             DO ji = fs_2, fs_jpim1   ! vector opt. 
    342                z2d(ji,jj) = z2d(ji,jj) + pua(ji,jj,jk)  
    343             END DO 
    344          END DO 
    345        END DO 
     321      z2d(:,:) = puflx(:,:,1)  
     322      DO_3D_00_00( 1, jpkm1 ) 
     323         z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)  
     324      END_3D 
    346325       CALL lbc_lnk( 'diaar5', z2d, 'U', -1. ) 
    347326       IF( cptr == 'adv' ) THEN 
    … …  
    354333       ENDIF 
    355334       ! 
    356        z2d(:,:) = pva(:,:,1)  
    357        DO jk = 1, jpkm1 
    358           DO jj = 2, jpjm1 
    359              DO ji = fs_2, fs_jpim1   ! vector opt. 
    360                 z2d(ji,jj) = z2d(ji,jj) + pva(ji,jj,jk)  
    361              END DO 
    362           END DO 
    363        END DO 
     335       z2d(:,:) = pvflx(:,:,1)  
     336       DO_3D_00_00( 1, jpkm1 ) 
     337          z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)  
     338       END_3D 
    364339       CALL lbc_lnk( 'diaar5', z2d, 'V', -1. ) 
    365340       IF( cptr == 'adv' ) THEN 
    … …  
    406381         zvol0 (:,:) = 0._wp 
    407382         thick0(:,:) = 0._wp 
    408          DO jk = 1, jpkm1 
    409             DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    410                DO ji = 1, jpi 
    411                   idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    412                   zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * area(ji,jj) 
    413                   thick0(ji,jj) = thick0(ji,jj) +  idep     
    414                END DO 
    415             END DO 
    416          END DO 
     383         DO_3D_11_11( 1, jpkm1 ) 
     384            idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
     385            zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * area(ji,jj) 
     386            thick0(ji,jj) = thick0(ji,jj) +  idep     
     387         END_3D 
    417388         vol0 = glob_sum( 'diaar5', zvol0 ) 
    418389         DEALLOCATE( zvol0 ) 
    … …  
    428399            sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
    429400            IF( ln_zps ) THEN               ! z-coord. partial steps 
    430                DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    431                   DO ji = 1, jpi 
    432                      ik = mbkt(ji,jj) 
    433                      IF( ik > 1 ) THEN 
    434                         zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    435                         sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
    436                      ENDIF 
    437                   END DO 
    438                END DO 
     401               DO_2D_11_11 
     402                  ik = mbkt(ji,jj) 
     403                  IF( ik > 1 ) THEN 
     404                     zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     405                     sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
     406                  ENDIF 
     407               END_2D 
    439408            ENDIF 
    440409            ! 
Note: See TracChangeset for help on using the changeset viewer.