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/2020/dev_12905_xios_restart/src/TOP – NEMO

source: NEMO/branches/2020/dev_12905_xios_restart/src/TOP/trcrst.F90 @ 12961

Last change on this file since 12961 was 12961, checked in by andmirek, 4 years ago

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