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.
trcstp.F90 in branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcstp.F90 @ 7701

Last change on this file since 7701 was 7701, checked in by frrh, 7 years ago

Improve control of numstr unit.

In addition to only producing output, and doing the
related global sums when we really need them, we
need to restrict it to one instance on the master PE
in all circumstances and to explicitly close it at the
end of the run. (Currently if lwp = true you get a separate
file for every PE containing identical information and none
of the tracer.stat files are explicitly closed.)

File size: 9.2 KB
RevLine 
[1457]1MODULE trcstp
2   !!======================================================================
3   !!                       ***  MODULE trcstp  ***
4   !! Time-stepping    : time loop of opa for passive tracer
5   !!======================================================================
[2528]6   !! History :  1.0  !  2004-03  (C. Ethe)  Original
7   !!----------------------------------------------------------------------
[1457]8#if defined key_top
9   !!----------------------------------------------------------------------
10   !!   trc_stp      : passive tracer system time-stepping
11   !!----------------------------------------------------------------------
12   USE oce_trc          ! ocean dynamics and active tracers variables
[4306]13   USE sbc_oce
[2528]14   USE trc
[1457]15   USE trctrp           ! passive tracers transport
16   USE trcsms           ! passive tracers sources and sinks
17   USE prtctl_trc       ! Print control for debbuging
18   USE trcdia
19   USE trcwri
20   USE trcrst
[4990]21   USE trdtrc_oce
22   USE trdmxl_trc
[1457]23   USE iom
24   USE in_out_manager
[3294]25   USE trcsub
[1457]26
27   IMPLICIT NONE
28   PRIVATE
29
[2528]30   PUBLIC   trc_stp    ! called by step
[3294]31
[5385]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
[3294]38   !! * Substitutions
39#  include "domzgr_substitute.h90"
[1457]40   !!----------------------------------------------------------------------
[2528]41   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
[7692]42   !! $Id$
[2528]43   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1457]44   !!----------------------------------------------------------------------
45CONTAINS
46
47   SUBROUTINE trc_stp( kt )
48      !!-------------------------------------------------------------------
49      !!                     ***  ROUTINE trc_stp  ***
50      !!                     
51      !! ** Purpose : Time loop of opa for passive tracer
52      !!
53      !! ** Method  :
54      !!              Compute the passive tracers trends
55      !!              Update the passive tracers
56      !!-------------------------------------------------------------------
[7701]57
58      USE dom_oce, ONLY: narea 
59
[3294]60      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
61      INTEGER               ::  jk, jn  ! dummy loop indices
62      REAL(wp)              ::  ztrai
[4306]63      CHARACTER (len=25)    ::  charout 
64
[2528]65      !!-------------------------------------------------------------------
[3294]66      !
67      IF( nn_timing == 1 )   CALL timing_start('trc_stp')
68      !
[4990]69      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
[3294]70      !
[3319]71      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution
[3294]72         DO jk = 1, jpk
73            cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
74         END DO
[3319]75         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol
[3294]76         areatot         = glob_sum( cvol(:,:,:) )
77      ENDIF
[5385]78      !
79      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
[3294]80      !   
[4306]81      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping
82      !   
83      IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step
[2528]84         !
85         IF(ln_ctl) THEN
86            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
87            CALL prt_ctl_trc_info(charout)
88         ENDIF
89         !
90         tra(:,:,:,:) = 0.e0
91         !
[7693]92# if defined key_debug_medusa
93         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt
94         CALL flush(numout)
95# endif
[3294]96                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file
[7693]97# if defined key_debug_medusa
98                                   CALL trc_rst_stat 
99                                   CALL trc_rst_tra_stat
100# endif
[3680]101         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
[3294]102         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager
103         ELSE                  ;   CALL trc_dia      ( kt )       ! output of passive tracers with old I/O manager
[2528]104         ENDIF
[3294]105                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
[7693]106# if defined key_debug_medusa
107         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt
108         CALL trc_rst_stat
109         CALL trc_rst_tra_stat
110         CALL flush(numout)
111# endif
[3294]112                                   CALL trc_trp      ( kt )       ! transport of passive tracers
[7693]113# if defined key_debug_medusa
114         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt
115         CALL trc_rst_stat
116         CALL trc_rst_tra_stat
117         CALL flush(numout)
118# endif
[4147]119         IF( kt == nittrc000 ) THEN
120            CALL iom_close( numrtr )       ! close input tracer restart file
[4624]121            IF(lwm) CALL FLUSH( numont )   ! flush namelist output
[4147]122         ENDIF
[3294]123         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
[4990]124         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer
[2528]125         !
[3294]126         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
[7693]127# if defined key_debug_medusa
128         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt
129         CALL flush(numout)
130# endif
[3294]131         !
[1457]132      ENDIF
[3294]133      !
[7694]134      IF (ln_ctl) THEN
135         ! The following code is very expensive since it involves multiple
136         ! reproducible global sums over all tracer fields and is potentially
137         ! called on every timestep. The results it produces are purely for
138         ! informational purposes and do not affect model evolution.
139         ! Hence we restrict its use by protecting it with the ln_ctl RTL
140         ! which should normally only be used under debugging conditions
[7701]141         ! and not in operational runs. We also need to restrict output
142         ! to the master PE since there's no point duplicating the same results
143         ! on all processors.   
144         ztrai = 0._wp                                !  content of all tracers
[7694]145         DO jn = 1, jptra
146            ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
147         END DO
[7701]148         IF (narea == 1) WRITE(numstr,9300) kt,  ztrai / areatot
[7694]1499300     FORMAT(i10,e18.10)
150      ENDIF
[3294]151      !
152      IF( nn_timing == 1 )   CALL timing_stop('trc_stp')
153      !
[1457]154   END SUBROUTINE trc_stp
155
[5385]156   SUBROUTINE trc_mean_qsr( kt )
157      !!----------------------------------------------------------------------
158      !!             ***  ROUTINE trc_mean_qsr  ***
159      !!
160      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case
161      !!               of diurnal cycle
162      !!
163      !! ** Method  : store in TOP the qsr every hour ( or every time-step the latter
164      !!              is greater than 1 hour ) and then, compute the  mean with
165      !!              a moving average over 24 hours.
166      !!              In coupled mode, the sampling is done at every coupling frequency
167      !!----------------------------------------------------------------------
168      INTEGER, INTENT(in) ::   kt
169      INTEGER  :: jn
170
171      IF( kt == nittrc000 ) THEN
[5407]172         IF( ln_cpl )  THEN 
[5385]173            rdt_sampl = 86400. / ncpl_qsr_freq
174            nb_rec_per_days = ncpl_qsr_freq
175         ELSE 
176            rdt_sampl = MAX( 3600., rdt * nn_dttrc )
177            nb_rec_per_days = INT( 86400 / rdt_sampl )
178         ENDIF
179         !
180         IF( lwp ) THEN
181            WRITE(numout,*) 
182            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_days
183            WRITE(numout,*) 
184         ENDIF
185         !
186         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) )
187         DO jn = 1, nb_rec_per_days
188            qsr_arr(:,:,jn) = qsr(:,:)
189         ENDDO
190         qsr_mean(:,:) = qsr(:,:)
191         !
192         isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
193         iseclast = isecfst
194         !
195      ENDIF
196      !
197      iseclast = nsec_year + nsec1jan000
198      llnew   = ( iseclast - isecfst )  > INT( rdt_sampl )   !   new shortwave to store
199      IF( kt /= nittrc000 .AND. llnew ) THEN
200          IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, &
201             &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours '
202          isecfst = iseclast
203          DO jn = 1, nb_rec_per_days - 1
204             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
205          ENDDO
206          qsr_arr (:,:,nb_rec_per_days) = qsr(:,:)
207          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days
208      ENDIF
209      !
210   END SUBROUTINE trc_mean_qsr
211
[1457]212#else
213   !!----------------------------------------------------------------------
214   !!   Default key                                     NO passive tracers
215   !!----------------------------------------------------------------------
216CONTAINS
217   SUBROUTINE trc_stp( kt )        ! Empty routine
218      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
219   END SUBROUTINE trc_stp
220#endif
221
222   !!======================================================================
223END MODULE trcstp
Note: See TracBrowser for help on using the repository browser.