source: NEMO/trunk/src/TOP/trcstp.F90 @ 10570

Last change on this file since 10570 was 10570, checked in by acc, 18 months ago

Trunk update to implement finer control over the choice of text report files generated. See ticket: #2167

  • Property svn:keywords set to Id
File size: 11.3 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 trcwri
18   USE trcrst
19   USE trcsub         !
20   USE trdtrc_oce
21   USE trdmxl_trc
22   USE sms_pisces,  ONLY : ln_check_mass
23   !
24   USE prtctl_trc     ! Print control for debbuging
25   USE iom            !
26   USE in_out_manager !
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   trc_stp    ! called by step
32
33   LOGICAL  ::   llnew                   ! ???
34   REAL(wp) ::   rdt_sampl               ! ???
35   INTEGER  ::   nb_rec_per_day, ktdcy   ! ???
36   REAL(wp) ::   rsecfst, rseclast       ! ???
37   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr   ! save qsr during TOP time-step
38
39   !!----------------------------------------------------------------------
40   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
41   !! $Id$
42   !! Software governed by the CeCILL license (see ./LICENSE)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE trc_stp( kt )
47      !!-------------------------------------------------------------------
48      !!                     ***  ROUTINE trc_stp  ***
49      !!                     
50      !! ** Purpose :   Time loop of opa for passive tracer
51      !!
52      !! ** Method  :   Compute the passive tracers trends
53      !!                Update the passive tracers
54      !!-------------------------------------------------------------------
55      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
56      !
57      INTEGER ::   jk, jn   ! dummy loop indices
58      REAL(wp)::   ztrai    ! local scalar
59      LOGICAL ::   ll_trcstat ! local logical
60      CHARACTER (len=25) ::   charout   !
61      !!-------------------------------------------------------------------
62      !
63      IF( ln_timing )   CALL timing_start('trc_stp')
64      !
65      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
66         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping)
67      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
68         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog)
69      ENDIF
70      !
71      ll_trcstat  = ( ln_ctl .OR. sn_cfctl%l_trcstat ) .AND. &
72     &              ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
73      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
74      !
75      IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution
76         DO jk = 1, jpk
77            cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)
78         END DO
79         IF ( ln_ctl .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend )              &
80            & .OR. iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" )   &
81            & .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) )                           &
82            &     areatot = glob_sum( 'trcstp', cvol(:,:,:) )
83      ENDIF
84      !
85      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
86      !   
87      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping
88      !   
89      IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step
90         !
91         IF(ln_ctl) THEN
92            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
93            CALL prt_ctl_trc_info(charout)
94         ENDIF
95         !
96         tra(:,:,:,:) = 0.e0
97         !
98                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file
99         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
100                                   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager
101                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
102                                   CALL trc_trp      ( kt )       ! transport of passive tracers
103         IF( kt == nittrc000 ) THEN
104            CALL iom_close( numrtr )       ! close input tracer restart file
105            IF(lwm) CALL FLUSH( numont )   ! flush namelist output
106         ENDIF
107         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
108         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer
109         !
110         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
111         !
112      ENDIF
113      !
114      IF (ll_trcstat) THEN
115         ztrai = 0._wp                                                   !  content of all tracers
116         DO jn = 1, jptra
117            ztrai = ztrai + glob_sum( 'trcstp', trn(:,:,:,jn) * cvol(:,:,:)   )
118         END DO
119         IF( lwm ) WRITE(numstr,9300) kt,  ztrai / areatot
120      ENDIF
1219300  FORMAT(i10,D23.16)
122      !
123      IF( ln_timing )   CALL timing_stop('trc_stp')
124      !
125   END SUBROUTINE trc_stp
126
127
128   SUBROUTINE trc_mean_qsr( kt )
129      !!----------------------------------------------------------------------
130      !!             ***  ROUTINE trc_mean_qsr  ***
131      !!
132      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case
133      !!               of diurnal cycle
134      !!
135      !! ** Method  : store in TOP the qsr every hour ( or every time-step if the latter
136      !!              is greater than 1 hour ) and then, compute the  mean with
137      !!              a moving average over 24 hours.
138      !!              In coupled mode, the sampling is done at every coupling frequency
139      !!----------------------------------------------------------------------
140      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
141      !
142      INTEGER  ::   jn   ! dummy loop indices
143      REAL(wp) ::   zkt, zrec     ! local scalars
144      CHARACTER(len=1) ::   cl1   ! 1 character
145      CHARACTER(len=2) ::   cl2   ! 2 characters
146      !!----------------------------------------------------------------------
147      !
148      IF( ln_timing )   CALL timing_start('trc_mean_qsr')
149      !
150      IF( kt == nittrc000 ) THEN
151         IF( ln_cpl )  THEN 
152            rdt_sampl = rday / ncpl_qsr_freq
153            nb_rec_per_day = ncpl_qsr_freq
154         ELSE 
155            rdt_sampl = MAX( 3600., rdttrc )
156            nb_rec_per_day = INT( rday / rdt_sampl )
157         ENDIF
158         !
159         IF(lwp) THEN
160            WRITE(numout,*) 
161            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day
162            WRITE(numout,*) 
163         ENDIF
164         !
165         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
166         !
167         !                                            !* Restart: read in restart file
168         IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0  &
169           &                              .AND. iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0  &
170           &                              .AND. iom_varid( numrtr, 'ktdcy'    , ldstop = .FALSE. ) > 0  &
171           &                              .AND. iom_varid( numrtr, 'nrdcy'    , ldstop = .FALSE. ) > 0  ) THEN
172
173            CALL iom_get( numrtr, 'ktdcy', zkt ) 
174            rsecfst = INT( zkt ) * rdttrc
175            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s '
176            CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr
177            CALL iom_get( numrtr, 'nrdcy', zrec )   !  Number of record per days
178            IF( INT( zrec ) == nb_rec_per_day ) THEN
179               DO jn = 1, nb_rec_per_day 
180                  IF( jn <= 9 )  THEN
181                    WRITE(cl1,'(i1)') jn
182                    CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )   !  A mean of qsr
183                  ELSE
184                    WRITE(cl2,'(i2.2)') jn
185                    CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr
186                  ENDIF
187              END DO
188            ELSE
189               DO jn = 1, nb_rec_per_day
190                  qsr_arr(:,:,jn) = qsr_mean(:,:)
191               ENDDO
192            ENDIF
193         ELSE                                         !* no restart: set from nit000 values
194            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values'
195            rsecfst  = kt * rdttrc
196            !
197            qsr_mean(:,:) = qsr(:,:)
198            DO jn = 1, nb_rec_per_day
199               qsr_arr(:,:,jn) = qsr_mean(:,:)
200            END DO
201         ENDIF
202         !
203      ENDIF
204      !
205      rseclast = kt * rdttrc
206      !
207      llnew   = ( rseclast - rsecfst ) .ge.  rdt_sampl    !   new shortwave to store
208      IF( llnew ) THEN
209          ktdcy = kt
210          IF( lwp .AND. kt < nittrc000 + 100 ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', ktdcy, &
211             &                      ' time = ', rseclast/3600.,'hours '
212          rsecfst = rseclast
213          DO jn = 1, nb_rec_per_day - 1
214             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
215          ENDDO
216          qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
217          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
218      ENDIF
219      !
220      IF( lrst_trc ) THEN    !* Write the mean of qsr in restart file
221         IF(lwp) WRITE(numout,*)
222         IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file  kt =', kt
223         IF(lwp) WRITE(numout,*) '~~~~~~~'
224         zkt  = REAL( ktdcy, wp )
225         zrec = REAL( nb_rec_per_day, wp )
226         CALL iom_rstput( kt, nitrst, numrtw, 'ktdcy', zkt  )
227         CALL iom_rstput( kt, nitrst, numrtw, 'nrdcy', zrec )
228          DO jn = 1, nb_rec_per_day 
229             IF( jn <= 9 )  THEN
230               WRITE(cl1,'(i1)') jn
231               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )
232             ELSE
233               WRITE(cl2,'(i2.2)') jn
234               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )
235             ENDIF
236         END DO
237         CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
238      ENDIF
239      !
240      IF( ln_timing )   CALL timing_stop('trc_mean_qsr')
241      !
242   END SUBROUTINE trc_mean_qsr
243
244#else
245   !!----------------------------------------------------------------------
246   !!   Default key                                     NO passive tracers
247   !!----------------------------------------------------------------------
248CONTAINS
249   SUBROUTINE trc_stp( kt )        ! Empty routine
250      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
251   END SUBROUTINE trc_stp
252#endif
253
254   !!======================================================================
255END MODULE trcstp
Note: See TracBrowser for help on using the repository browser.