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

source: NEMO/trunk/src/TOP/trcrst.F90

Last change on this file was 14239, checked in by smasson, 3 years ago

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