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.
trcrst.F90 in NEMO/branches/2021/dev_r14318_RK3_stage1/src/TOP – NEMO

source: NEMO/branches/2021/dev_r14318_RK3_stage1/src/TOP/trcrst.F90 @ 15321

Last change on this file since 15321 was 15321, checked in by techene, 3 years ago

#2605 #2715 some cleanning
  • Property svn:keywords set to Id
File size: 18.7 KB
Line 
1MODULE trcrst
2   !!======================================================================
3   !!                         ***  MODULE trcrst  ***
4   !! TOP :   Manage the passive tracer restart
5   !!======================================================================
6   !! History :    -   !  1991-03  ()  original code
7   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
8   !!              -   !  2005-10 (C. Ethe) print control
9   !!             2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture
10   !!             4.x  !  2021-08 (S. Techene, G. Madec) RK3  time-stepping only deals with before read/write
11   !!----------------------------------------------------------------------
12#if defined key_top
13   !!----------------------------------------------------------------------
14   !!   'key_top'                                                TOP models
15   !!----------------------------------------------------------------------
16   !!----------------------------------------------------------------------
17   !!   trc_rst        : Restart for passive tracer
18   !!   trc_rst_opn    : open  restart file
19   !!   trc_rst_read   : read  restart file
20   !!   trc_rst_wri    : write restart file
21   !!----------------------------------------------------------------------
22   USE par_trc        ! need jptra, number of passive tracers
23   USE oce_trc
24   USE trc
25   USE iom
26   USE daymod
27   USE lib_mpp
28   
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   trc_rst_opn       ! called by ???
33   PUBLIC   trc_rst_read      ! called by ???
34   PUBLIC   trc_rst_wri       ! called by ???
35   PUBLIC   trc_rst_cal
36
37#  include "domzgr_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
40   !! $Id$
41   !! Software governed by the CeCILL license (see ./LICENSE)
42   !!----------------------------------------------------------------------
43CONTAINS
44   
45   SUBROUTINE trc_rst_opn( kt )
46      !!----------------------------------------------------------------------
47      !!                    ***  trc_rst_opn  ***
48      !!
49      !! ** purpose  :   output of sea-trc variable in a netcdf file
50      !!----------------------------------------------------------------------
51      INTEGER, INTENT(in) ::   kt       ! number of iteration
52      !
53      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
54      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
55      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
56      CHARACTER(LEN=50)   ::   clpname  ! trc output restart file name including AGRIF
57      !!----------------------------------------------------------------------
58      !
59      IF( l_offline ) THEN
60         IF( kt == nittrc000 ) THEN
61            lrst_trc = .FALSE.
62            IF( ln_rst_list ) THEN
63               nrst_lst = 1
64               nitrst = nn_stocklist( nrst_lst )
65            ELSE
66               nitrst = nitend
67            ENDIF
68         ENDIF
69
70         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN
71            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
72            nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing
73            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
74         ENDIF
75      ELSE
76         IF( kt == nittrc000 ) lrst_trc = .FALSE.
77      ENDIF
78
79      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart
80
81      ! to get better performances with NetCDF format:
82      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1)
83      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1
84      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend - 1 .AND. .NOT. lrst_trc ) ) THEN
85         ! beware of the format used to write kt (default is i8.8, that should be large enough)
86         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
87         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
88         ENDIF
89         ! create the file
90         IF(lwp) WRITE(numout,*)
91         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
92         clpath = TRIM(cn_trcrst_outdir)
93         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
94         IF(lwp) WRITE(numout,*) &
95             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname
96         IF(.NOT.lwxios) THEN
97            CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE. )
98         ELSE
99#if defined key_xios
100            cw_toprst_cxt = "rstwt_"//TRIM(ADJUSTL(clkt))
101            IF( TRIM(Agrif_CFixed()) == '0' ) THEN
102               clpname = clname
103            ELSE
104               clpname = TRIM(Agrif_CFixed())//"_"//clname
105            ENDIF
106            numrtw = iom_xios_setid(TRIM(clpath)//TRIM(clpname))
107            CALL iom_init( cw_toprst_cxt, kdid = numrtw, ld_closedef = .FALSE. )
108#else
109            CALL ctl_stop( 'Can not use XIOS in trc_rst_opn' )
110#endif
111         ENDIF
112         lrst_trc = .TRUE.
113      ENDIF
114      !
115   END SUBROUTINE trc_rst_opn
116
117   SUBROUTINE trc_rst_read( Kbb, Kmm )
118      !!----------------------------------------------------------------------
119      !!                    ***  trc_rst_opn  ***
120      !!
121      !! ** purpose  :   read passive tracer fields in restart files
122      !!----------------------------------------------------------------------
123      INTEGER, INTENT( in ) ::   Kbb, Kmm  ! time level indices
124      INTEGER  ::  jn     
125
126      !!----------------------------------------------------------------------
127      !
128      IF(lwp) WRITE(numout,*)
129      IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
130      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
131
132      ! READ prognostic variables and computes diagnostic variable
133#if ! defined key_RK3
134      DO jn = 1, jptra      ! MLF only : Now time step
135         CALL iom_get( numrtr, jpdom_auto, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )
136      END DO
137#endif
138      DO jn = 1, jptra      ! RK3 and MLF : Before time step
139         CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )
140      END DO
141      !
142      IF(.NOT.lrxios) CALL iom_delay_rst( 'READ', 'TOP', numrtr )   ! read only TOP delayed global communication variables
143   END SUBROUTINE trc_rst_read
144
145
146   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Kaa )
147      !!----------------------------------------------------------------------
148      !!                    ***  trc_rst_wri  ***
149      !!
150      !! ** purpose  :   write passive tracer fields in restart files
151      !!----------------------------------------------------------------------
152      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index
153      INTEGER, INTENT( in ) ::   Kbb, Kmm, Kaa   ! time level indices
154      !!
155      INTEGER  :: jn
156      !!----------------------------------------------------------------------
157      !
158      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rn_Dt )   ! passive tracer time step (= ocean time step)
159      ! prognostic variables
160      ! --------------------
161#if defined key_RK3
162      DO jn = 1, jptra      ! MLF : After time step (before the swap) put in TRN
163         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kaa) )
164      END DO
165      DO jn = 1, jptra      ! RK3 : After time step (before the swap) put in TRB
166         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kaa) )
167      END DO
168#else
169      DO jn = 1, jptra      ! MLF : After time step (before the swap) put in TRN
170         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kaa) )
171      END DO
172      DO jn = 1, jptra      ! MLF : Now   time step (before the swap) put in TRB
173         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )
174      END DO
175#endif
176      IF( .NOT. lwxios ) CALL iom_delay_rst( 'WRITE', 'TOP', numrtw )   ! save only TOP delayed global communication variables
177   
178      IF( kt == nitrst ) THEN
179          CALL trc_rst_stat( Kaa, Kbb )             ! statistics Kaa et Kbb
180          IF(lwxios) THEN
181             CALL iom_context_finalize(      cw_toprst_cxt          )
182             iom_file(numrtw)%nfid       = 0
183             numrtw = 0
184          ELSE
185             CALL iom_close( numrtw )     ! close the restart file (only at last time step)
186          ENDIF
187#if ! defined key_trdmxl_trc
188          lrst_trc = .FALSE.
189#endif
190          IF( l_offline .AND. ln_rst_list ) THEN
191             nrst_lst = nrst_lst + 1
192             nitrst = nn_stocklist( nrst_lst )
193          ENDIF
194      ENDIF
195      !
196   END SUBROUTINE trc_rst_wri 
197
198
199   SUBROUTINE trc_rst_cal( kt, cdrw )
200      !!---------------------------------------------------------------------
201      !!                   ***  ROUTINE trc_rst_cal  ***
202      !!
203      !!  ** Purpose : Read or write calendar in restart file:
204      !!
205      !!  WRITE(READ) mode:
206      !!       kt        : number of time step since the begining of the experiment at the
207      !!                   end of the current(previous) run
208      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
209      !!                   end of the current(previous) run (REAL -> keep fractions of day)
210      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
211      !!
212      !!   According to namelist parameter nrstdt,
213      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
214      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
215      !!                   time step of previous run + 1.
216      !!       In both those options, the  exact duration of the experiment
217      !!       since the beginning (cumulated duration of all previous restart runs)
218      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt.
219      !!       This is valid is the time step has remained constant.
220      !!
221      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
222      !!                    has been stored in the restart file.
223      !!----------------------------------------------------------------------
224      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
225      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
226      !
227      LOGICAL  ::  llok
228      REAL(wp) ::  zrdttrc1, zkt, zndastp, zdayfrac, ksecs, ktime
229      INTEGER  ::   ihour, iminute
230      CHARACTER(len=82) :: clpname
231
232      ! Time domain : restart
233      ! ---------------------
234
235      IF( TRIM(cdrw) == 'READ' ) THEN
236
237         IF(lwp) WRITE(numout,*)
238         IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
239         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
240
241         IF( ln_rsttr ) THEN
242            lxios_sini = .FALSE.
243            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr )
244            IF( lrxios) THEN
245                cr_toprst_cxt = 'top_rst'
246                IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for TOP'
247!               IF( TRIM(Agrif_CFixed()) == '0' ) THEN
248!                  clpname = cn_trcrst_in
249!               ELSE
250!                  clpname = TRIM(Agrif_CFixed())//"_"//cn_trcrst_in   
251!               ENDIF
252                CALL iom_init( cr_toprst_cxt, kdid = numrtr, ld_closedef = .TRUE. )
253            ENDIF
254
255            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
256
257            IF(lwp) THEN
258               WRITE(numout,*) ' *** Info read in restart : '
259               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
260               WRITE(numout,*) ' *** restart option'
261               SELECT CASE ( nn_rsttr )
262               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
263               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
264               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
265               END SELECT
266               WRITE(numout,*)
267            ENDIF
268            ! Control of date
269            IF( nittrc000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  &
270               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
271               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
272         ENDIF
273         !
274         IF( l_offline ) THEN   
275            !                                          ! set the date in offline mode
276            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
277               CALL iom_get( numrtr, 'ndastp', zndastp )
278               ndastp = NINT( zndastp )
279               CALL iom_get( numrtr, 'adatrj', adatrj  )
280               CALL iom_get( numrtr, 'ntime' , ktime   )
281               nn_time0=INT(ktime)
282               ! calculate start time in hours and minutes
283               zdayfrac=adatrj-INT(adatrj)
284               ksecs = NINT(zdayfrac*86400)            ! Nearest second to catch rounding errors in adatrj
285               ihour = INT(ksecs/3600)
286               iminute = ksecs/60-ihour*60
287               
288               ! Add to nn_time0
289               nhour   =   nn_time0 / 100
290               nminute = ( nn_time0 - nhour * 100 )
291               nminute=nminute+iminute
292               
293               IF( nminute >= 60 ) THEN
294                  nminute=nminute-60
295                  nhour=nhour+1
296               ENDIF
297               nhour=nhour+ihour
298               IF( nhour >= 24 ) THEN
299                  nhour=nhour-24
300                  adatrj=adatrj+1
301               ENDIF           
302               nn_time0 = nhour * 100 + nminute
303               adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated           
304             ELSE
305               ndt05 = NINT( 0.5 * rn_Dt  )   !  --- WARNING --- not defined yet are we did not go through day_init
306               ! parameters corresponding to nit000 - 1 (as we start the step
307               ! loop with a call to day)
308               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam
309               nhour   =   nn_time0 / 100
310               nminute = ( nn_time0 - nhour * 100 )
311               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
312               adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday
313               ! note this is wrong if time step has changed during run
314            ENDIF
315            IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
316            !
317            IF(lwp) THEN
318              WRITE(numout,*) ' *** Info used values : '
319              WRITE(numout,*) '   date ndastp                                      : ', ndastp
320              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
321              WRITE(numout,*) '   nn_time0                                         : ', nn_time0
322              WRITE(numout,*)
323            ENDIF
324            !
325            IF( ln_rsttr )  THEN   ;    l_1st_euler = .false.
326            ELSE                   ;    l_1st_euler = .true.
327            ENDIF
328            !
329            CALL day_init          ! compute calendar
330            !
331         ENDIF
332         !
333      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
334         !
335         IF(  kt == nitrst ) THEN
336            IF(lwp) WRITE(numout,*)
337            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
338            IF(lwp) WRITE(numout,*) '~~~~~~~'
339         ENDIF
340         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp)   )   ! time-step
341         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp)   )   ! date
342         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj              )   ! number of elapsed days since
343         !                                                                     ! the begining of the run [s]
344         CALL iom_rstput( kt, nitrst, numrtw, 'ntime'  , REAL( nn_time0, wp) ) ! time
345      ENDIF
346
347   END SUBROUTINE trc_rst_cal
348
349
350   SUBROUTINE trc_rst_stat( Kmm, Krhs )
351      !!----------------------------------------------------------------------
352      !!                    ***  trc_rst_stat  ***
353      !!
354      !! ** purpose  :   Compute tracers statistics
355      !!----------------------------------------------------------------------
356      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices
357      INTEGER  :: jk, jn
358      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
359      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
360      !!----------------------------------------------------------------------
361
362      IF( lwp ) THEN
363         WRITE(numout,*) 
364         WRITE(numout,*) '           ----TRACER STAT----             '
365         WRITE(numout,*) 
366      ENDIF
367      !
368      DO jk = 1, jpk
369         zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Krhs) * tmask(:,:,jk)
370      END DO
371      !
372      DO jn = 1, jptra
373         ztraf = glob_sum( 'trcrst', tr(:,:,:,jn,Kmm) * zvol(:,:,:) )
374         zmin  = MINVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
375         zmax  = MAXVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
376         IF( lk_mpp ) THEN
377            CALL mpp_min( 'trcrst', zmin )      ! min over the global domain
378            CALL mpp_max( 'trcrst', zmax )      ! max over the global domain
379         END IF
380         zmean  = ztraf / areatot
381         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp
382         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
383      END DO
384      IF(lwp) WRITE(numout,*) 
3859000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
386      &      '    max :',e18.10,'    drift :',e18.10, ' %')
387      !
388   END SUBROUTINE trc_rst_stat
389
390#else
391   !!----------------------------------------------------------------------
392   !!  Dummy module :                                     No passive tracer
393   !!----------------------------------------------------------------------
394CONTAINS
395   SUBROUTINE trc_rst_read( Kbb, Kmm)                      ! Empty routines
396      INTEGER, INTENT( in ) :: Kbb, Kmm  ! time level indices
397   END SUBROUTINE trc_rst_read
398   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs )
399      INTEGER, INTENT( in ) :: kt
400      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices
401      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
402   END SUBROUTINE trc_rst_wri   
403#endif
404
405   !!----------------------------------------------------------------------
406   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
407   !! $Id$
408   !! Software governed by the CeCILL license (see ./LICENSE)
409   !!======================================================================
410END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.