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/TOP/TRP/trdmxl_trc.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/TOP/TRP/trdmxl_trc.F90

    r10425 r13463  
    1616   !!   trd_mxl_trc_init : initialization step 
    1717   !!---------------------------------------------------------------------- 
    18    USE trc               ! tracer definitions (trn, trb, tra, etc.) 
    19    USE trc_oce, ONLY :   nn_dttrc  ! frequency of step on passive tracers 
     18   USE trc               ! tracer definitions (tr etc.) 
    2019   USE dom_oce           ! domain definition 
    2120   USE zdfmxl  , ONLY : nmln ! number of level in the mixed layer 
     
    5049   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   ! 
    5150 
     51   !! * Substitutions 
     52#  include "do_loop_substitute.h90" 
     53#  include "domzgr_substitute.h90" 
    5254   !!---------------------------------------------------------------------- 
    5355   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    7072 
    7173 
    72    SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn ) 
     74   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 
    7375      !!---------------------------------------------------------------------- 
    7476      !!                  ***  ROUTINE trd_mxl_trc_zint  *** 
     
    9294      !! 
    9395      INTEGER, INTENT( in ) ::   ktrd, kjn                        ! ocean trend index and passive tracer rank 
     96      INTEGER, INTENT( in ) ::   Kmm                              ! time level index 
    9497      CHARACTER(len=2), INTENT( in ) ::  ctype                    ! surface/bottom (2D) or interior (3D) physics 
    9598      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmxl ! passive tracer trend 
     
    108111         ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer 
    109112         SELECT CASE ( nn_ctls_trc )                                ! choice of the control surface 
    110             CASE ( -2  )   ;   STOP 'trdmxl_trc : not ready '     !     -> isopycnal surface (see ???) 
     113            CASE ( -2  )   ;   CALL ctl_stop( 'STOP', 'trdmxl_trc : not ready ' )     !     -> isopycnal surface (see ???) 
    111114            CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion 
    112115            CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl) 
     
    122125 
    123126            IF( jpktrd_trc < jpk ) THEN                           ! description ??? 
    124                DO jj = 1, jpj 
    125                   DO ji = 1, jpi 
    126                      IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
    127                         zvlmsk(ji,jj) = tmask(ji,jj,1) 
    128                      ELSE 
    129                         isum = isum + 1 
    130                         zvlmsk(ji,jj) = 0.e0 
    131                      ENDIF 
    132                   END DO 
    133                END DO 
     127               DO_2D( 1, 1, 1, 1 ) 
     128                  IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
     129                     zvlmsk(ji,jj) = tmask(ji,jj,1) 
     130                  ELSE 
     131                     isum = isum + 1 
     132                     zvlmsk(ji,jj) = 0.e0 
     133                  ENDIF 
     134               END_2D 
    134135            ENDIF 
    135136 
     
    147148         ! ... Weights for vertical averaging 
    148149         wkx_trc(:,:,:) = 0.e0 
    149          DO jk = 1, jpktrd_trc                                    ! initialize wkx_trc with vertical scale factor in mixed-layer 
    150             DO jj = 1, jpj 
    151                DO ji = 1, jpi 
    152                   IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    153                END DO 
    154             END DO 
    155          END DO 
     150         DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) 
     151            IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     152         END_3D 
    156153          
    157154         rmld_trc(:,:) = 0.e0 
     
    183180 
    184181 
    185    SUBROUTINE trd_mxl_trc( kt ) 
     182   SUBROUTINE trd_mxl_trc( kt, Kmm ) 
    186183      !!---------------------------------------------------------------------- 
    187184      !!                  ***  ROUTINE trd_mxl_trc  *** 
     
    232229      ! 
    233230      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     231      INTEGER, INTENT(in) ::   Kmm                              ! time level index 
    234232      ! 
    235233      INTEGER ::   ji, jj, jk, jl, ik, it, itmod, jn 
     
    251249 
    252250 
    253       IF( nn_dttrc  /= 1  )   CALL ctl_stop( " Be careful, trends diags never validated " ) 
    254  
    255251      ! ====================================================================== 
    256252      ! I. Diagnose the purely vertical (K_z) diffusion trend 
     
    263259         ! 
    264260         DO jn = 1, jptra 
    265             DO jj = 1, jpj 
    266                DO ji = 1, jpi 
    267                   ik = nmld_trc(ji,jj) 
    268                   IF( ln_trdtrc(jn) )    & 
    269                   tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  & 
    270                        &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            & 
    271                        &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 
    272                END DO 
    273             END DO 
     261            DO_2D( 1, 1, 1, 1 ) 
     262               ik = nmld_trc(ji,jj) 
     263               IF( ln_trdtrc(jn) )    & 
     264               tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik)  & 
     265                    &                    * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) )            & 
     266                    &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 
     267            END_2D 
    274268         END DO 
    275269 
     
    322316         DO jn = 1, jptra 
    323317            IF( ln_trdtrc(jn) ) & 
    324                tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * trn(:,:,jk,jn) 
     318               tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * tr(:,:,jk,jn,Kmm) 
    325319         END DO 
    326320      END DO 
     
    328322      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window     
    329323      ! ------------------------------------------------------------------------ 
    330       IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
     324      IF( kt == nittrc000 + 1 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
    331325         ! 
    332326         DO jn = 1, jptra 
     
    408402         DO jn = 1, jptra 
    409403            IF( ln_trdtrc(jn) ) THEN 
    410                !-- Compute total trends    (use rdttrc instead of rdt ???) 
     404               !-- Compute total trends  
    411405               IF ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN  ! EULER-FORWARD schemes 
    412                   ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rdt 
     406                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rn_Dt 
    413407               ELSE                                                                     ! LEAP-FROG schemes 
    414                   ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*rdt) 
     408                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*rn_Dt) 
    415409               ENDIF 
    416410                
     
    431425 
    432426#if defined key_diainstant 
    433                STOP 'tmltrd_trc : key_diainstant was never checked within trdmxl. Comment this to proceed.' 
     427               CALL ctl_stop( 'STOP', 'tmltrd_trc : key_diainstant was never checked within trdmxl. Comment this to proceed.' ) 
    434428#endif 
    435429            ENDIF 
     
    446440            IF( ln_trdtrc(jn) ) THEN 
    447441               tml_sum_trc(:,:,jn) = tmlbn_trc(:,:,jn) + 2 * ( tml_sum_trc(:,:,jn) - tml_trc(:,:,jn) ) + tml_trc(:,:,jn) 
    448                ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) /  ( 2.*rdt )    ! now tracer unit is /sec 
     442               ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) /  ( 2.*rn_Dt )    ! now tracer unit is /sec 
    449443            ENDIF 
    450444         END DO 
     
    857851#  if defined key_diainstant 
    858852      IF( .NOT. ln_trdmxl_trc_instant ) THEN 
    859          STOP 'trd_mxl_trc : this was never checked. Comment this line to proceed...' 
    860       ENDIF 
    861       zsto = nn_trd_trc * rdt 
     853         CALL ctl_stop( 'STOP', 'trd_mxl_trc : this was never checked. Comment this line to proceed...' ) 
     854      ENDIF 
     855      zsto = nn_trd_trc * rn_Dt 
    862856      clop = "inst("//TRIM(clop)//")" 
    863857#  else 
    864858      IF( ln_trdmxl_trc_instant ) THEN 
    865          zsto = rdt                                               ! inst. diags : we use IOIPSL time averaging 
     859         zsto = rn_Dt                                               ! inst. diags : we use IOIPSL time averaging 
    866860      ELSE 
    867          zsto = nn_trd_trc * rdt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging 
     861         zsto = nn_trd_trc * rn_Dt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging 
    868862      ENDIF 
    869863      clop = "ave("//TRIM(clop)//")" 
    870864#  endif 
    871       zout = nn_trd_trc * rdt 
    872       iiter = ( nittrc000 - 1 ) / nn_dttrc 
     865      zout = nn_trd_trc * rn_Dt 
     866      iiter = nittrc000 - 1 
    873867 
    874868      IF(lwp) WRITE (numout,*) '                netCDF initialization' 
     
    876870      ! II.2 Compute julian date from starting date of the run 
    877871      ! ------------------------------------------------------ 
    878       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
     872      CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 
    879873      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    880874      IF(lwp) WRITE(numout,*)' '   
     
    908902            CALL dia_nam( clhstnam, nn_trd_trc, csuff ) 
    909903            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    910                &        1, jpi, 1, jpj, iiter, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 
     904               &        1, jpi, 1, jpj, iiter, zjulian, rn_Dt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 
    911905       
    912906            !-- Define the ML depth variable 
     
    928922      !-- Define miscellaneous passive tracer mixed-layer variables  
    929923      IF( jpltrd_trc /= jpmxl_trc_atf .OR.  jpltrd_trc - 1 /= jpmxl_trc_radb ) THEN 
    930          STOP 'Error : jpltrd_trc /= jpmxl_trc_atf .OR.  jpltrd_trc - 1 /= jpmxl_trc_radb' ! see below 
     924         CALL ctl_stop( 'STOP', 'Error : jpltrd_trc /= jpmxl_trc_atf .OR.  jpltrd_trc - 1 /= jpmxl_trc_radb' ) ! see below 
    931925      ENDIF 
    932926 
     
    945939               CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jl,2)), clmxl//" "//clvar//ctrd_trc(jl,1),                      &  
    946940                 &    cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean 
    947             END DO                                                                         ! if zsto=rdt above 
     941            END DO                                                                         ! if zsto=rn_Dt above 
    948942          
    949943            CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmxl_trc_radb,2)), clmxl//" "//clvar//ctrd_trc(jpmxl_trc_radb,1), &  
     
    970964   !!---------------------------------------------------------------------- 
    971965CONTAINS 
    972    SUBROUTINE trd_mxl_trc( kt )                                   ! Empty routine 
     966   SUBROUTINE trd_mxl_trc( kt, Kmm )                                   ! Empty routine 
    973967      INTEGER, INTENT( in) ::   kt 
     968      INTEGER, INTENT( in) ::   Kmm            ! time level index 
    974969      WRITE(*,*) 'trd_mxl_trc: You should not have seen this print! error?', kt 
    975970   END SUBROUTINE trd_mxl_trc 
    976    SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn ) 
     971   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 
    977972      INTEGER               , INTENT( in ) ::  ktrd, kjn              ! ocean trend index and passive tracer rank 
     973      INTEGER               , INTENT( in ) ::  Kmm                    ! time level index 
    978974      CHARACTER(len=2)      , INTENT( in ) ::  ctype                  ! surface/bottom (2D) or interior (3D) physics 
    979975      REAL, DIMENSION(:,:,:), INTENT( in ) ::  ptrc_trdmxl            ! passive trc trend 
Note: See TracChangeset for help on using the changeset viewer.