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 13766 for NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD – NEMO

Ignore:
Timestamp:
2020-11-10T12:57:08+01:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2475: merge with trunk rev 13688

Location:
NEMO/branches/2020/dev_12905_xios_ancil
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_12905_xios_ancil

    • 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_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13559        sette 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD/trddyn.F90

    r12489 r13766  
    3737   !! * Substitutions 
    3838#  include "do_loop_substitute.h90" 
     39#  include "domzgr_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    123124                              z3dx(:,:,:) = 0._wp                  ! U.dxU & V.dyV (approximation) 
    124125                              z3dy(:,:,:) = 0._wp 
    125                               DO_3D_00_00( 1, jpkm1 ) 
     126                              DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! no mask as un,vn are masked 
    126127                                 z3dx(ji,jj,jk) = uu(ji,jj,jk,Kmm) * ( uu(ji+1,jj,jk,Kmm) - uu(ji-1,jj,jk,Kmm) ) / ( 2._wp * e1u(ji,jj) ) 
    127128                                 z3dy(ji,jj,jk) = vv(ji,jj,jk,Kmm) * ( vv(ji,jj+1,jk,Kmm) - vv(ji,jj-1,jk,Kmm) ) / ( 2._wp * e2v(ji,jj) ) 
    128129                              END_3D 
    129                               CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. ) 
     130                              CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 
    130131                              CALL iom_put( "utrd_udx", z3dx  ) 
    131132                              CALL iom_put( "vtrd_vdy", z3dy  ) 
    … …  
    163164!                                 END DO 
    164165!                              END DO 
    165 !                              CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. ) 
     166!                              CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1.0_wp, z3dy, 'V', -1.0_wp ) 
    166167!                              CALL iom_put( "utrd_bfr", z3dx ) 
    167168!                              CALL iom_put( "vtrd_bfr", z3dy ) 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD/trdglo.F90

    r12489 r13766  
    5252   !! * Substitutions 
    5353#  include "do_loop_substitute.h90" 
     54#  include "domzgr_substitute.h90" 
    5455   !!---------------------------------------------------------------------- 
    5556   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8586         ! 
    8687         CASE( 'TRA' )          !==  Tracers (T & S)  ==! 
    87             DO_3D_11_11( 1, jpkm1 ) 
     88            DO_3D( 1, 1, 1, 1, 1, jpkm1 )   ! global sum of mask volume trend and trend*T (including interior mask) 
    8889               zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    8990               zvt = ptrdx(ji,jj,jk) * zvm 
    … …  
    114115            ! 
    115116         CASE( 'DYN' )          !==  Momentum and KE  ==!         
    116             DO_3D_10_10( 1, jpkm1 ) 
     117            DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    117118               zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    118119                  &                                     * e1e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) 
    … …  
    126127            IF( ktrd == jpdyn_zdf ) THEN      ! zdf trend: compute separately the surface forcing trend 
    127128               z1_2rho0 = 0.5_wp / rho0 
    128                DO_2D_10_10 
     129               DO_2D( 1, 0, 1, 0 ) 
    129130                  zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    130131                     &                                                     * z1_2rho0       * e1e2u(ji,jj) 
    … …  
    210211          
    211212         zcof   = 0.5_wp / rho0           ! Density flux at u and v-points 
    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) ) 
     213         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     214            zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm)   & 
     215               &                              *  uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
     216            zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm)   & 
     217               &                              *  vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
    215218         END_3D 
    216219          
    217          DO_3D_00_00( 1, jpkm1 ) 
     220         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Density flux divergence at t-point 
    218221            zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
    219222               &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
    … …  
    226229         peke = 0._wp 
    227230         DO jk = 1, jpkm1 
    228             peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) * e3t(:,:,jk,Kmm) ) 
     231            peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:)   & 
     232               &                               * e3t(:,:,jk,Kmm) ) 
    229233         END DO 
    230234         peke = grav * peke 
    … …  
    523527      tvolv = 0._wp 
    524528 
    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) 
     529      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     530         tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm)   & 
     531            &                                       * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
     532         tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm)   & 
     533            &                                       * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    528534      END_3D 
    529535      CALL mpp_sum( 'trdglo', tvolu )   ! sums over the global domain 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD/trdken.F90

    r12489 r13766  
    4141   !! * Substitutions 
    4242#  include "do_loop_substitute.h90" 
     43#  include "domzgr_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    4445   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8990      !!---------------------------------------------------------------------- 
    9091      ! 
    91       CALL lbc_lnk_multi( 'trdken', putrd, 'U', -1. , pvtrd, 'V', -1. )      ! lateral boundary conditions 
     92      CALL lbc_lnk_multi( 'trdken', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp )      ! lateral boundary conditions 
    9293      ! 
    9394      nkstp = kt 
    … …  
    101102      zke(1,:, : ) = 0._wp 
    102103      zke(:,1, : ) = 0._wp 
    103       DO_3D_01_01( 1, jpkm1 ) 
     104      DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 
    104105         zke(ji,jj,jk) = 0.5_wp * rho0 *( uu(ji  ,jj,jk,Kmm) * putrd(ji  ,jj,jk) * bu(ji  ,jj,jk)  & 
    105106            &                           + uu(ji-1,jj,jk,Kmm) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk)  & 
    … …  
    122123                           z2dy(:,:) = vv(:,:,1,Kmm) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 
    123124                           zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
    124                            DO_2D_01_01 
     125                           DO_2D( 0, 1, 0, 1 ) 
    125126                              zke2d(ji,jj) = r1_rho0 * 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
    126127                              &                                   + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
    … …  
    218219 
    219220      ! conv value on T-point 
    220       DO_3D_11_11( 1, jpkm1 ) 
     221      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    221222         zcoef = 0.5_wp / e3t(ji,jj,jk,Kmm) 
    222223         pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD/trdmxl.F90

    r12377 r13766  
    7070   !! * Substitutions 
    7171#  include "do_loop_substitute.h90" 
     72#  include "domzgr_substitute.h90" 
    7273   !!---------------------------------------------------------------------- 
    7374   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    119120         ! 
    120121         wkx(:,:,:) = 0._wp         !==  now ML weights for vertical averaging  ==! 
    121          DO_3D_11_11( 1, jpktrd ) 
    122             IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     122         DO_3D( 1, 1, 1, 1, 1, jpktrd )  ! initialize wkx with vertical scale factor in mixed-layer 
     123            IF( jk - kmxln(ji,jj) < 0 )   THEN 
     124               wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     125            ENDIF 
    123126         END_3D 
    124127         hmxl(:,:) = 0._wp               ! NOW mixed-layer depth 
    … …  
    151154!!gm to be put juste before the output ! 
    152155!      ! Lateral boundary conditions 
    153 !      CALL lbc_lnk_multi( 'trdmxl', tmltrd(:,:,jl), 'T', 1. , smltrd(:,:,jl), 'T', 1. ) 
     156!      CALL lbc_lnk_multi( 'trdmxl', tmltrd(:,:,jl), 'T', 1.0_wp , smltrd(:,:,jl), 'T', 1.0_wp ) 
    154157!!gm end 
    155158 
    … …  
    469472         !-- Lateral boundary conditions 
    470473         !         ... temperature ...                    ... salinity ... 
    471          CALL lbc_lnk_multi( 'trdmxl', ztmltot , 'T', 1., zsmltot , 'T', 1., & 
    472                   &          ztmlres , 'T', 1., zsmlres , 'T', 1., & 
    473                   &          ztmlatf , 'T', 1., zsmlatf , 'T', 1. ) 
     474         CALL lbc_lnk_multi( 'trdmxl', ztmltot , 'T', 1.0_wp, zsmltot , 'T', 1.0_wp, & 
     475                  &          ztmlres , 'T', 1.0_wp, zsmlres , 'T', 1.0_wp, & 
     476                  &          ztmlatf , 'T', 1.0_wp, zsmlatf , 'T', 1.0_wp ) 
    474477 
    475478 
    … …  
    520523         !-- Lateral boundary conditions 
    521524         !         ... temperature ...                    ... salinity ... 
    522          CALL lbc_lnk_multi( 'trdmxl', ztmltot2, 'T', 1., zsmltot2, 'T', 1., & 
    523                   &          ztmlres2, 'T', 1., zsmlres2, 'T', 1. ) 
    524          ! 
    525          CALL lbc_lnk_multi( 'trdmxl', ztmltrd2(:,:,:), 'T', 1., zsmltrd2(:,:,:), 'T', 1. ) ! /  in the NetCDF trends file 
     525         CALL lbc_lnk_multi( 'trdmxl', ztmltot2, 'T', 1.0_wp, zsmltot2, 'T', 1.0_wp, & 
     526                  &          ztmlres2, 'T', 1.0_wp, zsmlres2, 'T', 1.0_wp ) 
     527         ! 
     528         CALL lbc_lnk_multi( 'trdmxl', ztmltrd2(:,:,:), 'T', 1.0_wp, zsmltrd2(:,:,:), 'T', 1.0_wp ) ! /  in the NetCDF trends file 
    526529          
    527530         ! III.3 Time evolution array swap 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD/trdmxl_rst.F90

    r11536 r13766  
    149149      IF( ln_trdmxl_instant ) THEN  
    150150         !-- Temperature 
    151          CALL iom_get( inum, jpdom_autoglo, 'tmlbb'           , tmlbb          ) 
    152          CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn          ) 
    153          CALL iom_get( inum, jpdom_autoglo, 'tmlatfb'         , tmlatfb        ) 
     151         CALL iom_get( inum, jpdom_auto, 'tmlbb'           , tmlbb          ) 
     152         CALL iom_get( inum, jpdom_auto, 'tmlbn'           , tmlbn          ) 
     153         CALL iom_get( inum, jpdom_auto, 'tmlatfb'         , tmlatfb        ) 
    154154         ! 
    155155         !-- Salinity 
    156          CALL iom_get( inum, jpdom_autoglo, 'smlbb'           , smlbb          ) 
    157          CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn          ) 
    158          CALL iom_get( inum, jpdom_autoglo, 'smlatfb'         , smlatfb        ) 
     156         CALL iom_get( inum, jpdom_auto, 'smlbb'           , smlbb          ) 
     157         CALL iom_get( inum, jpdom_auto, 'smlbn'           , smlbn          ) 
     158         CALL iom_get( inum, jpdom_auto, 'smlatfb'         , smlatfb        ) 
    159159      ELSE 
    160          CALL iom_get( inum, jpdom_autoglo, 'hmxlbn'          , hmxlbn         ) ! needed for hmxl_sum 
     160         CALL iom_get( inum, jpdom_auto, 'hmxlbn'          , hmxlbn         ) ! needed for hmxl_sum 
    161161         ! 
    162162         !-- Temperature 
    163          CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn          ) ! needed for tml_sum 
    164          CALL iom_get( inum, jpdom_autoglo, 'tml_sumb'        , tml_sumb       ) 
     163         CALL iom_get( inum, jpdom_auto, 'tmlbn'           , tmlbn          ) ! needed for tml_sum 
     164         CALL iom_get( inum, jpdom_auto, 'tml_sumb'        , tml_sumb       ) 
    165165         DO jk = 1, jpltrd 
    166166            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('tmltrd_csum_ub_', I1)")   jk 
    167167            ELSE                 ;   WRITE(charout,FMT="('tmltrd_csum_ub_', I2)")   jk 
    168168            ENDIF 
    169             CALL iom_get( inum, jpdom_autoglo, charout, tmltrd_csum_ub(:,:,jk) ) 
     169            CALL iom_get( inum, jpdom_auto, charout, tmltrd_csum_ub(:,:,jk) ) 
    170170         END DO 
    171          CALL iom_get( inum, jpdom_autoglo, 'tmltrd_atf_sumb' , tmltrd_atf_sumb) 
     171         CALL iom_get( inum, jpdom_auto, 'tmltrd_atf_sumb' , tmltrd_atf_sumb) 
    172172         ! 
    173173         !-- Salinity 
    174          CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn          ) ! needed for sml_sum 
    175          CALL iom_get( inum, jpdom_autoglo, 'sml_sumb'        , sml_sumb       ) 
     174         CALL iom_get( inum, jpdom_auto, 'smlbn'           , smlbn          ) ! needed for sml_sum 
     175         CALL iom_get( inum, jpdom_auto, 'sml_sumb'        , sml_sumb       ) 
    176176         DO jk = 1, jpltrd 
    177177            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('smltrd_csum_ub_', I1)")   jk 
    178178            ELSE                 ;   WRITE(charout,FMT="('smltrd_csum_ub_', I2)")   jk 
    179179            ENDIF 
    180             CALL iom_get( inum, jpdom_autoglo, charout, smltrd_csum_ub(:,:,jk) ) 
     180            CALL iom_get( inum, jpdom_auto, charout, smltrd_csum_ub(:,:,jk) ) 
    181181         END DO 
    182          CALL iom_get( inum, jpdom_autoglo, 'smltrd_atf_sumb' , smltrd_atf_sumb) 
     182         CALL iom_get( inum, jpdom_auto, 'smltrd_atf_sumb' , smltrd_atf_sumb) 
    183183         ! 
    184184         CALL iom_close( inum ) 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD/trdpen.F90

    r12377 r13766  
    3535   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_pe   ! partial derivatives of PE anomaly with respect to T and S 
    3636 
     37   !! * Substitutions 
     38#  include "domzgr_substitute.h90" 
    3739   !!---------------------------------------------------------------------- 
    3840   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4042   !! Software governed by the CeCILL license (see ./LICENSE) 
    4143   !!---------------------------------------------------------------------- 
     44 
    4245CONTAINS 
    4346 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD/trdtra.F90

    r12489 r13766  
    4242   !! * Substitutions 
    4343#  include "do_loop_substitute.h90" 
     44#  include "domzgr_substitute.h90" 
    4445   !!---------------------------------------------------------------------- 
    4546   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8283      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable 
    8384      ! 
    84       INTEGER ::   jk   ! loop indices 
     85      INTEGER ::   jk    ! loop indices 
     86      INTEGER ::   i01   ! 0 or 1 
    8587      REAL(wp),        DIMENSION(jpi,jpj,jpk) ::   ztrds             ! 3D workspace 
    8688      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwt, zws, ztrdt   ! 3D workspace 
    … …  
    9092         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 
    9193      ENDIF 
    92  
     94      ! 
     95      i01 = COUNT( (/ PRESENT(pu) .OR. ( ktrd /= jptra_xad .AND. ktrd /= jptra_yad .AND. ktrd /= jptra_zad ) /) ) 
     96      ! 
    9397      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN   !==  Temperature trend  ==! 
    9498         ! 
    95          SELECT CASE( ktrd ) 
     99         SELECT CASE( ktrd*i01 ) 
    96100         !                            ! advection: transform the advective flux into a trend 
    97101         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm )  
    … …  
    112116      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN      !==  Salinity trends  ==! 
    113117         ! 
    114          SELECT CASE( ktrd ) 
     118         SELECT CASE( ktrd*i01 ) 
    115119         !                            ! advection: transform the advective flux into a trend 
    116120         !                            !            and send T & S trends to trd_tra_mng 
    … …  
    128132            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
    129133            DO jk = 2, jpk 
    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) 
     134               zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) )   & 
     135                  &        / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
     136               zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) )   & 
     137                  &        / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
    132138            END DO 
    133139            ! 
    … …  
    142148            zwt(:,:,:) = 0._wp   ;   zws(:,:,:) = 0._wp            ! vertical diffusive fluxes 
    143149            DO jk = 2, jpk 
    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) 
     150               zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) )   & 
     151                  &            / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
     152               zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) )   & 
     153                  &            / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
    146154            END DO 
    147155            ! 
    … …  
    163171      IF( ctype == 'TRC' ) THEN                           !==  passive tracer trend  ==! 
    164172         ! 
    165          SELECT CASE( ktrd ) 
     173         SELECT CASE( ktrd*i01 ) 
    166174         !                            ! advection: transform the advective flux into a masked trend 
    167175         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm )  
    … …  
    202210      !!---------------------------------------------------------------------- 
    203211      ! 
    204       SELECT CASE( cdir )      ! shift depending on the direction 
     212      SELECT CASE( cdir )             ! shift depending on the direction 
    205213      CASE( 'X' )   ;   ii = 1   ;   ij = 0   ;   ik = 0      ! i-trend 
    206214      CASE( 'Y' )   ;   ii = 0   ;   ij = 1   ;   ik = 0      ! j-trend 
    … …  
    208216      END SELECT 
    209217      ! 
    210       !                        ! set to zero uncomputed values 
     218      !                               ! set to zero uncomputed values 
    211219      ptrd(jpi,:,:) = 0._wp   ;   ptrd(1,:,:) = 0._wp 
    212220      ptrd(:,jpj,:) = 0._wp   ;   ptrd(:,1,:) = 0._wp 
    213221      ptrd(:,:,jpk) = 0._wp 
    214222      ! 
    215       DO_3D_00_00( 1, jpkm1 ) 
     223      DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! advective trend 
    216224         ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        & 
    217225           &                  - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk)  )   & 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD/trdtrc.F90

    r12377 r13766  
    11MODULE trdtrc 
     2   USE par_kind 
    23   !!====================================================================== 
    34   !!                       ***  MODULE trdtrc  *** 
    … …  
    1213      INTEGER ::   kt, kjn, ktrd    
    1314      INTEGER ::   Kmm            ! time level index 
    14       REAL    ::   ptrtrd(:,:,:)   
     15      REAL(wp)::   ptrtrd(:,:,:)   
    1516      WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 
    1617      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn, ktrd, kt 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/TRD/trdvor.F90

    r12489 r13766  
    5757   !! * Substitutions 
    5858#  include "do_loop_substitute.h90" 
     59#  include "domzgr_substitute.h90" 
    5960   !!---------------------------------------------------------------------- 
    6061   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    102103      CASE( jpdyn_zad )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_zad, Kmm )   ! Vertical Advection  
    103104      CASE( jpdyn_spg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm )   ! Surface Pressure Grad.  
    104       CASE( jpdyn_zdf )                                                      ! Vertical Diffusion  
     105      CASE( jpdyn_zdf )                                                           ! Vertical Diffusion  
    105106         ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0 
    106          DO_2D_00_00 
     107         DO_2D( 0, 0, 0, 0 )                                                               ! wind stress trends 
    107108            ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 ) 
    108109            ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 ) 
    … …  
    161162 
    162163      zudpvor(:,:) = 0._wp                 ;   zvdpvor(:,:) = 0._wp                    ! Initialisation 
    163       CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1. , pvtrdvor, 'V', -1. )      ! lateral boundary condition 
     164      CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp )      ! lateral boundary condition 
    164165       
    165166 
    … …  
    171172      ! 
    172173      CASE( jpvor_bfr )        ! bottom friction 
    173          DO_2D_00_00 
     174         DO_2D( 0, 0, 0, 0 ) 
    174175            ikbu = mbkv(ji,jj) 
    175176            ikbv = mbkv(ji,jj)             
    … …  
    192193         DO jj = 1, jpjm1 
    193194            vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)       & 
    194                  &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) )   ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     195                 &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) )   ) & 
     196                 &                  / ( e1f(ji,jj) * e2f(ji,jj) ) 
    195197         END DO 
    196198      END DO 
    … …  
    249251      zvdpvor(:,:) = 0._wp 
    250252      !                            ! lateral boundary condition on input momentum trends 
    251       CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1. , pvtrdvor, 'V', -1. ) 
     253      CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) 
    252254 
    253255      !  ===================================== 
    … …  
    268270            DO jj = 1, jpjm1 
    269271               vortrd(ji,jj,jpvor_bev) = (    zvbet(ji+1,jj) - zvbet(ji,jj)     & 
    270                   &                       - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     272                  &                       - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) & 
     273                  &                           / ( e1f(ji,jj) * e2f(ji,jj) ) 
    271274            END DO 
    272275         END DO 
    … …  
    283286         DO jj=1,jpjm1 
    284287            vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)     & 
    285                &                  - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     288               &                  - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 
     289               &                         / ( e1f(ji,jj) * e2f(ji,jj) ) 
    286290         END DO 
    287291      END DO 
    … …  
    345349         DO jj = 1, jpjm1 
    346350            vor_avr(ji,jj) = (  ( zvv(ji+1,jj) - zvv(ji,jj) )    & 
    347                &              - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 
     351               &              - ( zuu(ji,jj+1) - zuu(ji,jj) ) )  & 
     352               &             / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 
    348353         END DO 
    349354      END DO 
    … …  
    395400 
    396401         ! Boundary conditions 
    397          CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1. , vor_avrres, 'F', 1. ) 
     402         CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp ) 
    398403 
    399404 
Note: See TracChangeset for help on using the changeset viewer.