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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/ZDF/zdfmxl.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • 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 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/ZDF/zdfmxl.F90

    r10425 r13463  
    1212   !!---------------------------------------------------------------------- 
    1313   USE oce            ! ocean dynamics and tracers variables 
     14   USE isf_oce        ! ice shelf 
    1415   USE dom_oce        ! ocean space and time domain variables 
    1516   USE trc_oce  , ONLY: l_offline         ! ocean space and time domain variables 
     
    3536   REAL(wp), PUBLIC ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    3637 
     38   !! * Substitutions 
     39#  include "do_loop_substitute.h90" 
     40#  include "domzgr_substitute.h90" 
    3741   !!---------------------------------------------------------------------- 
    3842   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5761 
    5862 
    59    SUBROUTINE zdf_mxl( kt ) 
     63   SUBROUTINE zdf_mxl( kt, Kmm ) 
    6064      !!---------------------------------------------------------------------- 
    6165      !!                  ***  ROUTINE zdfmxl  *** 
     
    7579      !!---------------------------------------------------------------------- 
    7680      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     81      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
    7782      ! 
    7883      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     
    9398      nmln(:,:)  = nlb10               ! Initialization to the number of w ocean point 
    9499      hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
    95       zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria 
    96       DO jk = nlb10, jpkm1 
    97          DO jj = 1, jpj                ! Mixed layer level: w-level  
    98             DO ji = 1, jpi 
    99                ikt = mbkt(ji,jj) 
    100                hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk) 
    101                IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
    102             END DO 
    103          END DO 
    104       END DO 
     100      zN2_c = grav * rho_c * r1_rho0   ! convert density criteria into N^2 criteria 
     101      DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 
     102         ikt = mbkt(ji,jj) 
     103         hmlp(ji,jj) =   & 
     104            & hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 
     105         IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
     106      END_3D 
    105107      ! 
    106108      ! w-level of the turbocline and mixing layer (iom_use) 
    107109      imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
    108       DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10  
    109          DO jj = 1, jpj 
    110             DO ji = 1, jpi 
    111                IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline  
    112             END DO 
    113          END DO 
    114       END DO 
     110      DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) 
     111         IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline  
     112      END_3D 
    115113      ! depth of the mixing and mixed layers 
    116       DO jj = 1, jpj 
    117          DO ji = 1, jpi 
    118             iiki = imld(ji,jj) 
    119             iikn = nmln(ji,jj) 
    120             hmld (ji,jj) = gdepw_n(ji,jj,iiki  ) * ssmask(ji,jj)    ! Turbocline depth  
    121             hmlp (ji,jj) = gdepw_n(ji,jj,iikn  ) * ssmask(ji,jj)    ! Mixed layer depth 
    122             hmlpt(ji,jj) = gdept_n(ji,jj,iikn-1) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
    123          END DO 
    124       END DO 
     114      DO_2D( 1, 1, 1, 1 ) 
     115         iiki = imld(ji,jj) 
     116         iikn = nmln(ji,jj) 
     117         hmld (ji,jj) = gdepw(ji,jj,iiki  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth  
     118         hmlp (ji,jj) = gdepw(ji,jj,iikn  ,Kmm) * ssmask(ji,jj)    ! Mixed layer depth 
     119         hmlpt(ji,jj) = gdept(ji,jj,iikn-1,Kmm) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
     120      END_2D 
    125121      ! 
    126122      IF( .NOT.l_offline ) THEN 
     
    137133      ENDIF 
    138134      ! 
    139       IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ' ) 
     135      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ' ) 
    140136      ! 
    141137   END SUBROUTINE zdf_mxl 
Note: See TracChangeset for help on using the changeset viewer.