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

source: NEMO/branches/UKMO/r12083_restart_datestamp/src/TOP/trcrst.F90

Last change on this file was 12477, checked in by jcastill, 4 years ago

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