source: branches/UKMO/dev_r5518_MEDUSA_stable_fixes_part2/NEMOGCM/NEMO/TOP_SRC/trcstp.F90 @ 7734

Last change on this file since 7734 was 7734, checked in by frrh, 4 years ago

Correction to output of global tracer sums.
Previous condition was failing to restrict it to master PE, hence writing
to dud units. It is not clear why this works in some configurations
and not others. We must ensure that the output unit is valid!

File size: 9.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 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
58      USE dom_oce, ONLY: narea
59
60      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
61      INTEGER               ::  jk, jn  ! dummy loop indices
62      REAL(wp)              ::  ztrai
63      CHARACTER (len=25)    ::  charout 
64
65      !!-------------------------------------------------------------------
66      !
67      IF( nn_timing == 1 )   CALL timing_start('trc_stp')
68      !
69      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
70      !
71      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution
72         DO jk = 1, jpk
73            cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
74         END DO
75         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol
76         areatot         = glob_sum( cvol(:,:,:) )
77      ENDIF
78      !
79      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
80      !   
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
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         !
92# if defined key_debug_medusa
93         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt
94         CALL flush(numout)
95# endif
96                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file
97# if defined key_debug_medusa
98                                   CALL trc_rst_stat 
99                                   CALL trc_rst_tra_stat
100# endif
101         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
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
104         ENDIF
105                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
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
112                                   CALL trc_trp      ( kt )       ! transport of passive tracers
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
119         IF( kt == nittrc000 ) THEN
120            CALL iom_close( numrtr )       ! close input tracer restart file
121            IF(lwm) CALL FLUSH( numont )   ! flush namelist output
122         ENDIF
123         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
124         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer
125         !
126         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
127# if defined key_debug_medusa
128         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt
129         CALL flush(numout)
130# endif
131         !
132      ENDIF
133      !
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
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
145         DO jn = 1, jptra
146            ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
147         END DO
148         IF( numstr /= 0 ) WRITE(numstr,9300) kt,  ztrai / areatot
1499300     FORMAT(i10,e18.10)
150      ENDIF
151      !
152      IF( nn_timing == 1 )   CALL timing_stop('trc_stp')
153      !
154   END SUBROUTINE trc_stp
155
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
172         IF( ln_cpl )  THEN 
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
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.