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
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      !!-------------------------------------------------------------------
[3294]57      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
58      INTEGER               ::  jk, jn  ! dummy loop indices
59      REAL(wp)              ::  ztrai
[4306]60      CHARACTER (len=25)    ::  charout 
61
[2528]62      !!-------------------------------------------------------------------
[3294]63      !
64      IF( nn_timing == 1 )   CALL timing_start('trc_stp')
65      !
[4990]66      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
[3294]67      !
[3319]68      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution
[3294]69         DO jk = 1, jpk
70            cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
71         END DO
[3319]72         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol
[3294]73         areatot         = glob_sum( cvol(:,:,:) )
74      ENDIF
[5385]75      !
76      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
[3294]77      !   
[4306]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
[2528]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         !
[7693]89# if defined key_debug_medusa
90         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt
91         CALL flush(numout)
92# endif
[3294]93                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file
[7693]94# if defined key_debug_medusa
95                                   CALL trc_rst_stat 
96                                   CALL trc_rst_tra_stat
97# endif
[3680]98         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
[3294]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
[2528]101         ENDIF
[3294]102                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
[7693]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
[3294]109                                   CALL trc_trp      ( kt )       ! transport of passive tracers
[7693]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
[4147]116         IF( kt == nittrc000 ) THEN
117            CALL iom_close( numrtr )       ! close input tracer restart file
[4624]118            IF(lwm) CALL FLUSH( numont )   ! flush namelist output
[4147]119         ENDIF
[3294]120         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
[4990]121         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer
[2528]122         !
[3294]123         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
[7693]124# if defined key_debug_medusa
125         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt
126         CALL flush(numout)
127# endif
[3294]128         !
[1457]129      ENDIF
[3294]130      !
[7694]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
[3294]146      !
147      IF( nn_timing == 1 )   CALL timing_stop('trc_stp')
148      !
[1457]149   END SUBROUTINE trc_stp
150
[5385]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
[5407]167         IF( ln_cpl )  THEN 
[5385]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
[1457]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.