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_GO6_package/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.
File size: 11.2 KB
Line 
1MODULE trcstp
2   !!======================================================================
3   !!                       ***  MODULE trcstp  ***
4   !! Time-stepping    : time loop of opa for passive tracer
5   !!======================================================================
6   !! History :  1.0  !  2004-03  (C. Ethe)  Original
7   !!----------------------------------------------------------------------
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
13   USE sbc_oce
14   USE trc
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
21   USE trcstat
22   USE trdtrc_oce
23   USE trdmxl_trc
24   USE iom
25   USE in_out_manager
26   USE trcsub
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   trc_stp    ! called by step
32
33   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step
34   REAL(wp) :: rdt_sampl
35   INTEGER  :: nb_rec_per_day
36   INTEGER  :: isecfst, iseclast
37   LOGICAL  :: llnew
38
39   !! * Substitutions
40#  include "domzgr_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
43   !! $Id$
44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE trc_stp( kt )
49      !!-------------------------------------------------------------------
50      !!                     ***  ROUTINE trc_stp  ***
51      !!                     
52      !! ** Purpose : Time loop of opa for passive tracer
53      !!
54      !! ** Method  :
55      !!              Compute the passive tracers trends
56      !!              Update the passive tracers
57      !!-------------------------------------------------------------------
58
59      USE dom_oce, ONLY: narea
60
61      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
62      INTEGER               ::  jk, jn  ! dummy loop indices
63      REAL(wp)              ::  ztrai
64      LOGICAL ::   ll_trcstat ! local logical
65      CHARACTER (len=25)    ::  charout 
66      !!-------------------------------------------------------------------
67      !
68      IF( nn_timing == 1 )   CALL timing_start('trc_stp')
69      !
70      ll_trcstat  = ( ln_ctl .OR. sn_cfctl%l_trcstat ) .AND. &
71     &              ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
72      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
73      !
74      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution
75         DO jk = 1, jpk
76            cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
77         END DO
78         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol
79         areatot         = glob_sum( cvol(:,:,:) )
80      ENDIF
81      !
82      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
83      !   
84      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping
85      !   
86      IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step
87         !
88         IF(ln_ctl) THEN
89            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
90            CALL prt_ctl_trc_info(charout)
91         ENDIF
92         !
93         tra(:,:,:,:) = 0.e0
94         !
95                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file
96         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
97         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager
98         ELSE                  ;   CALL trc_dia      ( kt )       ! output of passive tracers with old I/O manager
99         ENDIF
100                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
101# if defined key_debug_medusa
102         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt
103         CALL trc_rst_stat
104         CALL trc_rst_tra_stat
105         CALL flush(numout)
106# endif
107                                   CALL trc_trp      ( kt )       ! transport of passive tracers
108# if defined key_debug_medusa
109         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt
110         CALL trc_rst_stat
111         CALL trc_rst_tra_stat
112         CALL flush(numout)
113# endif
114         IF( kt == nittrc000 ) THEN
115            CALL iom_close( numrtr )       ! close input tracer restart file
116            IF(lwm) CALL FLUSH( numont )   ! flush namelist output
117         ENDIF
118         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
119         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer
120         !
121         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
122         !
123      ENDIF
124      !
125      IF (ll_trcstat) THEN 
126         ! The following code is very expensive since it involves multiple
127         ! reproducible global sums over all tracer fields and is potentially 
128         ! called on every timestep. The results it produces are purely for
129         ! informational purposes and do not affect model evolution.
130         ! Hence we restrict its use by protecting it with the ln_ctl RTL
131         ! which should normally only be used under debugging conditions
132         ! and not in operational runs. We also need to restrict output 
133         ! to the master PE since there's no point duplicating the same results
134         ! on all processors.   
135         ztrai = 0._wp                                                   !  content of all tracers
136         DO jn = 1, jptra
137            ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
138         END DO
139         IF( numstr /= -1 ) WRITE(numstr,9300) kt,  ztrai / areatot
1409300     FORMAT(i10,D23.16)
141      ENDIF
142      !
143      IF( nn_timing == 1 )   CALL timing_stop('trc_stp')
144      !
145   END SUBROUTINE trc_stp
146
147   SUBROUTINE trc_mean_qsr( kt )
148      !!----------------------------------------------------------------------
149      !!             ***  ROUTINE trc_mean_qsr  ***
150      !!
151      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case
152      !!               of diurnal cycle
153      !!
154      !! ** Method  : store in TOP the qsr every hour ( or every time-step if the latter
155      !!              is greater than 1 hour ) and then, compute the  mean with
156      !!              a moving average over 24 hours.
157      !!              In coupled mode, the sampling is done at every coupling frequency
158      !!----------------------------------------------------------------------
159      INTEGER, INTENT(in) ::   kt
160      INTEGER  :: jn
161      REAL(wp) :: zsecfst
162      CHARACTER(len=1)               ::   cl1                      ! 1 character
163      CHARACTER(len=2)               ::   cl2                      ! 2 characters
164
165      IF( kt == nittrc000 ) THEN
166         IF( ln_cpl )  THEN 
167            rdt_sampl = 86400. / ncpl_qsr_freq
168            nb_rec_per_day = ncpl_qsr_freq
169         ELSE 
170            rdt_sampl = MAX( 3600., rdt * nn_dttrc )
171            nb_rec_per_day = INT( 86400 / rdt_sampl )
172         ENDIF
173         !
174         IF( lwp ) THEN
175            WRITE(numout,*) 
176            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day
177            WRITE(numout,*) 
178         ENDIF
179         !
180         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
181         !
182         !                                            !* Restart: read in restart file
183         IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 &
184                                          .AND. iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0 &
185                                          .AND. iom_varid( numrtr, 'zsecfst'  , ldstop = .FALSE. ) > 0 ) THEN
186            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file'
187            CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr
188            CALL iom_get( numrtr, 'zsecfst', zsecfst )   !  A mean of qsr
189            isecfst = INT( zsecfst )
190            DO jn = 1, nb_rec_per_day 
191             IF( jn <= 9 )  THEN
192               WRITE(cl1,'(i1)') jn
193               CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )   !  A mean of qsr
194             ELSE
195               WRITE(cl2,'(i2.2)') jn
196               CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr
197             ENDIF
198           ENDDO
199         ELSE                                         !* no restart: set from nit000 values
200            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values'
201            isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
202            !
203            qsr_mean(:,:) = qsr(:,:)
204            DO jn = 1, nb_rec_per_day
205               qsr_arr(:,:,jn) = qsr_mean(:,:)
206            ENDDO
207         ENDIF
208         !
209      ENDIF
210      !
211      iseclast = nsec_year + nsec1jan000
212      !
213      llnew   = ( iseclast - isecfst )  > INT( rdt_sampl )   !   new shortwave to store
214      IF( llnew ) THEN
215          IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, &
216             &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours '
217          isecfst = iseclast
218          DO jn = 1, nb_rec_per_day - 1
219             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
220          ENDDO
221          qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
222          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
223      ENDIF
224      !
225      IF( lrst_trc ) THEN    !* Write the mean of qsr in restart file
226         IF(lwp) WRITE(numout,*)
227         IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file  kt =', kt
228         IF(lwp) WRITE(numout,*) '~~~~~~~'
229          DO jn = 1, nb_rec_per_day 
230             IF( jn <= 9 )  THEN
231               WRITE(cl1,'(i1)') jn
232               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )
233             ELSE
234               WRITE(cl2,'(i2.2)') jn
235               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )
236             ENDIF
237         ENDDO
238         CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
239         zsecfst = REAL( isecfst, wp )
240         CALL iom_rstput( kt, nitrst, numrtw, 'zsecfst', zsecfst )
241      ENDIF
242      !
243   END SUBROUTINE trc_mean_qsr
244
245#else
246   !!----------------------------------------------------------------------
247   !!   Default key                                     NO passive tracers
248   !!----------------------------------------------------------------------
249CONTAINS
250   SUBROUTINE trc_stp( kt )        ! Empty routine
251      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
252   END SUBROUTINE trc_stp
253#endif
254
255   !!======================================================================
256END MODULE trcstp
Note: See TracBrowser for help on using the repository browser.