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 @ 7694

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

Protect expensive global sums of all tracers from being performed
unconditionally with a rtl (ln_ctl). This code is only relevant for
debugging or other circumstances where the user needs to know
global tracer sums for bit comarison purposes.

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