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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcstp.F90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r4624 r6225  
    1919   USE trcwri 
    2020   USE trcrst 
    21    USE trdmod_trc_oce 
    22    USE trdmld_trc 
     21   USE trdtrc_oce 
     22   USE trdmxl_trc 
    2323   USE iom 
    2424   USE in_out_manager 
     
    3030   PUBLIC   trc_stp    ! called by step 
    3131 
    32    !! * Substitutions 
    33 #  include "domzgr_substitute.h90" 
     32   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step 
     33   REAL(wp) :: rdt_sampl 
     34   INTEGER  :: nb_rec_per_days 
     35   INTEGER  :: isecfst, iseclast 
     36   LOGICAL  :: llnew 
     37 
    3438   !!---------------------------------------------------------------------- 
    3539   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    5458      CHARACTER (len=25)    ::  charout  
    5559 
    56       REAL(wp), DIMENSION(:,:), POINTER ::   zqsr_tmp ! save qsr during TOP time-step 
    5760      !!------------------------------------------------------------------- 
    5861      ! 
    5962      IF( nn_timing == 1 )   CALL timing_start('trc_stp') 
    6063      ! 
    61       IF( kt == nittrc000 .AND. lk_trdmld_trc )  CALL trd_mld_trc_init    ! trends: Mixed-layer 
     64      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer 
    6265      ! 
    63       IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution 
     66      IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution 
    6467         DO jk = 1, jpk 
    65             cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     68            cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
    6669         END DO 
    6770         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol 
    6871         areatot         = glob_sum( cvol(:,:,:) ) 
    6972      ENDIF 
    70       !     
    71       IF( ltrcdm2dc ) THEN 
    72          ! When Diurnal cycle, core bulk and LIM2  are activated, put daily mean qsr in qsr for TOP/biogeochemistery time-step 
    73          ! and save qsr with diurnal cycle in qsr_tmp 
    74          CALL wrk_alloc( jpi,jpj, zqsr_tmp ) 
    75          zqsr_tmp(:,:) = qsr     (:,:) 
    76          qsr     (:,:) = qsr_mean(:,:)     
    77       ENDIF 
     73      ! 
     74      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt ) 
    7875      !     
    7976      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping 
     
    10097         ENDIF 
    10198         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file 
    102          IF( lk_trdmld_trc  )      CALL trd_mld_trc  ( kt )       ! trends: Mixed-layer 
     99         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer 
    103100         ! 
    104101         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
    105102         ! 
    106       ENDIF 
    107       ! 
    108       IF( ltrcdm2dc ) THEN 
    109          ! put back qsr with diurnal cycle in qsr 
    110          qsr(:,:) = zqsr_tmp(:,:) 
    111          CALL wrk_dealloc( jpi,jpj, zqsr_tmp ) 
    112103      ENDIF 
    113104      ! 
     
    123114   END SUBROUTINE trc_stp 
    124115 
     116 
     117   SUBROUTINE trc_mean_qsr( kt ) 
     118      !!---------------------------------------------------------------------- 
     119      !!             ***  ROUTINE trc_mean_qsr  *** 
     120      !! 
     121      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case 
     122      !!               of diurnal cycle 
     123      !! 
     124      !! ** Method  : store in TOP the qsr every hour ( or every time-step the latter  
     125      !!              is greater than 1 hour ) and then, compute the  mean with  
     126      !!              a moving average over 24 hours.  
     127      !!              In coupled mode, the sampling is done at every coupling frequency  
     128      !!---------------------------------------------------------------------- 
     129      INTEGER, INTENT(in) ::   kt 
     130      INTEGER  :: jn 
     131      !!---------------------------------------------------------------------- 
     132      ! 
     133      IF( kt == nittrc000 ) THEN 
     134         IF( ln_cpl )  THEN   
     135            rdt_sampl = 86400. / ncpl_qsr_freq 
     136            nb_rec_per_days = ncpl_qsr_freq 
     137         ELSE   
     138            rdt_sampl = MAX( 3600., rdt * nn_dttrc ) 
     139            nb_rec_per_days = INT( 86400 / rdt_sampl ) 
     140         ENDIF 
     141         ! 
     142         IF( lwp ) THEN 
     143            WRITE(numout,*)  
     144            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_days 
     145            WRITE(numout,*)  
     146         ENDIF 
     147         ! 
     148         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 
     149         DO jn = 1, nb_rec_per_days 
     150            qsr_arr(:,:,jn) = qsr(:,:) 
     151         ENDDO 
     152         qsr_mean(:,:) = qsr(:,:) 
     153         ! 
     154         isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
     155         iseclast = isecfst 
     156         ! 
     157      ENDIF 
     158      ! 
     159      iseclast = nsec_year + nsec1jan000 
     160      llnew   = ( iseclast - isecfst )  > INT( rdt_sampl )   !   new shortwave to store 
     161      IF( kt /= nittrc000 .AND. llnew ) THEN 
     162          IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, & 
     163             &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 
     164          isecfst = iseclast 
     165          DO jn = 1, nb_rec_per_days - 1 
     166             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 
     167          END DO 
     168          qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 
     169          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 
     170      ENDIF 
     171      ! 
     172   END SUBROUTINE trc_mean_qsr 
     173 
    125174#else 
    126175   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.