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

source: branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc_v2/NEMOGCM/NEMO/TOP_SRC/trcstp.F90 @ 8513

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

Commit changes relating to Met Office GMED ticket 340 for the
tidying of MEDUSA related code and debugging statements in the TOP code.

Only code introduced at revision 8434 of branch
​http://fcm3/projects/NEMO.xm/log/branches/NERC/dev_r5518_GO6_split_trcbiomedusa
is included here, all previous revisions of that branch having been dealt with
under GMED ticket 339.
File size: 11.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_day
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      IF( nn_timing == 1 )   CALL timing_start('trc_stp')
67      !
68      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
69      !
70      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution
71         DO jk = 1, jpk
72            cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
73         END DO
74         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol
75         areatot         = glob_sum( cvol(:,:,:) )
76      ENDIF
77      !
78      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
79      !   
80      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping
81      !   
82      IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step
83         !
84         IF(ln_ctl) THEN
85            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
86            CALL prt_ctl_trc_info(charout)
87         ENDIF
88         !
89         tra(:,:,:,:) = 0.e0
90         !
91                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file
92         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
93         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager
94         ELSE                  ;   CALL trc_dia      ( kt )       ! output of passive tracers with old I/O manager
95         ENDIF
96                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
97# if defined key_debug_medusa
98         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt
99         CALL trc_rst_stat
100         CALL trc_rst_tra_stat
101         CALL flush(numout)
102# endif
103                                   CALL trc_trp      ( kt )       ! transport of passive tracers
104# if defined key_debug_medusa
105         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt
106         CALL trc_rst_stat
107         CALL trc_rst_tra_stat
108         CALL flush(numout)
109# endif
110         IF( kt == nittrc000 ) THEN
111            CALL iom_close( numrtr )       ! close input tracer restart file
112            IF(lwm) CALL FLUSH( numont )   ! flush namelist output
113         ENDIF
114         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
115         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer
116         !
117         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
118         !
119      ENDIF
120      !
121      IF (ln_ctl) THEN 
122         ! The following code is very expensive since it involves multiple
123         ! reproducible global sums over all tracer fields and is potentially 
124         ! called on every timestep. The results it produces are purely for
125         ! informational purposes and do not affect model evolution.
126         ! Hence we restrict its use by protecting it with the ln_ctl RTL
127         ! which should normally only be used under debugging conditions
128         ! and not in operational runs. We also need to restrict output 
129         ! to the master PE since there's no point duplicating the same results
130         ! on all processors.   
131         ztrai = 0._wp                                                   !  content of all tracers
132         DO jn = 1, jptra
133            ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
134         END DO
135         IF( numstr /= -1 ) WRITE(numstr,9300) kt,  ztrai / areatot
1369300     FORMAT(i10,D23.16)
137      ENDIF
138      !
139      IF( nn_timing == 1 )   CALL timing_stop('trc_stp')
140      !
141   END SUBROUTINE trc_stp
142
143   SUBROUTINE trc_mean_qsr( kt )
144      !!----------------------------------------------------------------------
145      !!             ***  ROUTINE trc_mean_qsr  ***
146      !!
147      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case
148      !!               of diurnal cycle
149      !!
150      !! ** Method  : store in TOP the qsr every hour ( or every time-step if the latter
151      !!              is greater than 1 hour ) and then, compute the  mean with
152      !!              a moving average over 24 hours.
153      !!              In coupled mode, the sampling is done at every coupling frequency
154      !!----------------------------------------------------------------------
155      INTEGER, INTENT(in) ::   kt
156      INTEGER  :: jn
157      REAL(wp) :: zsecfst
158      CHARACTER(len=1)               ::   cl1                      ! 1 character
159      CHARACTER(len=2)               ::   cl2                      ! 2 characters
160
161      IF( kt == nittrc000 ) THEN
162         IF( ln_cpl )  THEN 
163            rdt_sampl = 86400. / ncpl_qsr_freq
164            nb_rec_per_day = ncpl_qsr_freq
165         ELSE 
166            rdt_sampl = MAX( 3600., rdt * nn_dttrc )
167            nb_rec_per_day = INT( 86400 / rdt_sampl )
168         ENDIF
169         !
170         IF( lwp ) THEN
171            WRITE(numout,*) 
172            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day
173            WRITE(numout,*) 
174         ENDIF
175         !
176         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
177         !
178         !                                            !* Restart: read in restart file
179         IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 .AND. &
180                            iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0 .AND. &
181                            iom_varid( numrtr, 'zsecfst'  , ldstop = .FALSE. ) > 0 ) THEN
182            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file'
183            CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr
184            CALL iom_get( numrtr, 'zsecfst', zsecfst )   !  A mean of qsr
185            isecfst = INT( zsecfst )
186            DO jn = 1, nb_rec_per_day 
187             IF( jn <= 9 )  THEN
188               WRITE(cl1,'(i1)') jn
189               CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )   !  A mean of qsr
190             ELSE
191               WRITE(cl2,'(i2.2)') jn
192               CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr
193             ENDIF
194           ENDDO
195         ELSE                                         !* no restart: set from nit000 values
196            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values'
197            isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
198            !
199            qsr_mean(:,:) = qsr(:,:)
200            DO jn = 1, nb_rec_per_day
201               qsr_arr(:,:,jn) = qsr_mean(:,:)
202            ENDDO
203         ENDIF
204         !
205      ENDIF
206      !
207      iseclast = nsec_year + nsec1jan000
208      !
209      llnew   = ( iseclast - isecfst )  > INT( rdt_sampl )   !   new shortwave to store
210      IF( llnew ) THEN
211          IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, &
212             &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours '
213          isecfst = iseclast
214          DO jn = 1, nb_rec_per_day - 1
215             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
216          ENDDO
217          qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
218          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
219      ENDIF
220      !
221      IF( lrst_trc ) THEN    !* Write the mean of qsr in restart file
222         IF(lwp) WRITE(numout,*)
223         IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file  kt =', kt
224         IF(lwp) WRITE(numout,*) '~~~~~~~'
225          DO jn = 1, nb_rec_per_day 
226             IF( jn <= 9 )  THEN
227               WRITE(cl1,'(i1)') jn
228               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )
229             ELSE
230               WRITE(cl2,'(i2.2)') jn
231               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )
232             ENDIF
233         ENDDO
234         CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
235         zsecfst = REAL( isecfst, wp )
236         CALL iom_rstput( kt, nitrst, numrtw, 'zsecfst', zsecfst )
237      ENDIF
238      !
239   END SUBROUTINE trc_mean_qsr
240
241#else
242   !!----------------------------------------------------------------------
243   !!   Default key                                     NO passive tracers
244   !!----------------------------------------------------------------------
245CONTAINS
246   SUBROUTINE trc_stp( kt )        ! Empty routine
247      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
248   END SUBROUTINE trc_stp
249#endif
250
251   !!======================================================================
252END MODULE trcstp
Note: See TracBrowser for help on using the repository browser.