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 branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 6741

Last change on this file since 6741 was 6741, checked in by malcolmroberts, 8 years ago

Fix the date stamp for the age tracer restart file (use UKMO/restart_datestamp code)
File size: 15.3 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   !!----------------------------------------------------------------------
18   !!----------------------------------------------------------------------
19   !!   'key_top'                                                TOP models
20   !!----------------------------------------------------------------------
21   !!   trc_rst_opn    : open  restart file
22   !!   trc_rst_read   : read  restart file
23   !!   trc_rst_wri    : write restart file
24   !!----------------------------------------------------------------------
25   USE oce_trc
26   USE trc
27   USE trcnam_trp
28   USE iom
29   USE in_out_manager , ONLY : ln_rstdate
30   USE daymod
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   !! * Substitutions
40#  include "top_substitute.h90"
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      INTEGER             ::   iyear, imonth, iday
52      REAL (wp)           ::   zsec
53      REAL (wp)           ::   zfjulday
54      !
55      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
56      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
57      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
58      !!----------------------------------------------------------------------
59      !
60      IF( lk_offline ) THEN
61         IF( kt == nittrc000 ) THEN
62            lrst_trc = .FALSE.
63            IF( ln_rst_list ) THEN
64               nrst_lst = 1
65               nitrst = nstocklist( nrst_lst )
66            ELSE
67               nitrst = nitend
68            ENDIF
69         ENDIF
70
71         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
72            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
73            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
74            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
75         ENDIF
76      ELSE
77         IF( kt == nittrc000 ) lrst_trc = .FALSE.
78      ENDIF
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 - 2*nn_dttrc + 1)
82      ! 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
83      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
84         IF ( ln_rstdate ) THEN
85!            CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec )           
86            zfjulday = fjulday + rdttra(1) / rday
87            IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
88            CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )         
89
90            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
91         ELSE
92            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
93            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
94            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
95            ENDIF
96         ENDIF
97         ! create the file
98         IF(lwp) WRITE(numout,*)
99         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
100         clpath = TRIM(cn_trcrst_outdir)
101         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
102         IF(lwp) WRITE(numout,*) &
103             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname
104         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
105         lrst_trc = .TRUE.
106      ENDIF
107      !
108   END SUBROUTINE trc_rst_opn
109
110   SUBROUTINE trc_rst_read
111      !!----------------------------------------------------------------------
112      !!                    ***  trc_rst_opn  ***
113      !!
114      !! ** purpose  :   read passive tracer fields in restart files
115      !!----------------------------------------------------------------------
116      INTEGER  ::  jn     
117
118      !!----------------------------------------------------------------------
119      !
120      IF(lwp) WRITE(numout,*)
121      IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
122      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
123
124      ! READ prognostic variables and computes diagnostic variable
125      DO jn = 1, jptra
126         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
127      END DO
128
129      DO jn = 1, jptra
130         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
131      END DO
132      !
133   END SUBROUTINE trc_rst_read
134
135   SUBROUTINE trc_rst_wri( kt )
136      !!----------------------------------------------------------------------
137      !!                    ***  trc_rst_wri  ***
138      !!
139      !! ** purpose  :   write passive tracer fields in restart files
140      !!----------------------------------------------------------------------
141      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
142      !!
143      INTEGER  :: jn
144      REAL(wp) :: zarak0
145      !!----------------------------------------------------------------------
146      !
147      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step
148      ! prognostic variables
149      ! --------------------
150      DO jn = 1, jptra
151         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
152      END DO
153
154      DO jn = 1, jptra
155         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
156      END DO
157      !
158      IF( kt == nitrst ) THEN
159          CALL trc_rst_stat            ! statistics
160          CALL iom_close( numrtw )     ! close the restart file (only at last time step)
161#if ! defined key_trdmxl_trc
162          lrst_trc = .FALSE.
163#endif
164          IF( lk_offline .AND. ln_rst_list ) THEN
165             nrst_lst = nrst_lst + 1
166             nitrst = nstocklist( nrst_lst )
167          ENDIF
168      ENDIF
169      !
170   END SUBROUTINE trc_rst_wri 
171
172
173   SUBROUTINE trc_rst_cal( kt, cdrw )
174      !!---------------------------------------------------------------------
175      !!                   ***  ROUTINE trc_rst_cal  ***
176      !!
177      !!  ** Purpose : Read or write calendar in restart file:
178      !!
179      !!  WRITE(READ) mode:
180      !!       kt        : number of time step since the begining of the experiment at the
181      !!                   end of the current(previous) run
182      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
183      !!                   end of the current(previous) run (REAL -> keep fractions of day)
184      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
185      !!
186      !!   According to namelist parameter nrstdt,
187      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
188      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
189      !!                   time step of previous run + 1.
190      !!       In both those options, the  exact duration of the experiment
191      !!       since the beginning (cumulated duration of all previous restart runs)
192      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt.
193      !!       This is valid is the time step has remained constant.
194      !!
195      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
196      !!                    has been stored in the restart file.
197      !!----------------------------------------------------------------------
198      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
199      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
200      !
201      INTEGER  ::  jlibalt = jprstlib
202      LOGICAL  ::  llok
203      REAL(wp) ::  zkt, zrdttrc1
204      REAL(wp) ::  zndastp
205
206      ! Time domain : restart
207      ! ---------------------
208
209      IF( TRIM(cdrw) == 'READ' ) THEN
210
211         IF(lwp) WRITE(numout,*)
212         IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
213         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
214
215         IF ( jprstlib == jprstdimg ) THEN
216           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
217           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
218           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
219           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
220         ENDIF
221
222         IF( ln_rsttr ) THEN
223            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
224            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
225
226            IF(lwp) THEN
227               WRITE(numout,*) ' *** Info read in restart : '
228               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
229               WRITE(numout,*) ' *** restart option'
230               SELECT CASE ( nn_rsttr )
231               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
232               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
233               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
234               END SELECT
235               WRITE(numout,*)
236            ENDIF
237            ! Control of date
238            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
239               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
240               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
241         ENDIF
242         !
243         IF( lk_offline ) THEN   
244            !                                          ! set the date in offline mode
245            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
246               CALL iom_get( numrtr, 'ndastp', zndastp ) 
247               ndastp = NINT( zndastp )
248               CALL iom_get( numrtr, 'adatrj', adatrj  )
249             ELSE
250               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
251               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
252               ! note this is wrong if time step has changed during run
253            ENDIF
254            !
255            IF(lwp) THEN
256              WRITE(numout,*) ' *** Info used values : '
257              WRITE(numout,*) '   date ndastp                                      : ', ndastp
258              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
259              WRITE(numout,*)
260            ENDIF
261            !
262            IF( ln_rsttr )  THEN   ;    neuler = 1
263            ELSE                   ;    neuler = 0
264            ENDIF
265            !
266            CALL day_init          ! compute calendar
267            !
268         ENDIF
269         !
270      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
271         !
272         IF(  kt == nitrst ) THEN
273            IF(lwp) WRITE(numout,*)
274            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
275            IF(lwp) WRITE(numout,*) '~~~~~~~'
276         ENDIF
277         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
278         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
279         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
280         !                                                                     ! the begining of the run [s]
281      ENDIF
282
283   END SUBROUTINE trc_rst_cal
284
285
286   SUBROUTINE trc_rst_stat
287      !!----------------------------------------------------------------------
288      !!                    ***  trc_rst_stat  ***
289      !!
290      !! ** purpose  :   Compute tracers statistics
291      !!----------------------------------------------------------------------
292      INTEGER  :: jk, jn
293      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
294      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
295      !!----------------------------------------------------------------------
296
297      IF( lwp ) THEN
298         WRITE(numout,*) 
299         WRITE(numout,*) '           ----TRACER STAT----             '
300         WRITE(numout,*) 
301      ENDIF
302      !
303      DO jk = 1, jpk
304         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
305      END DO
306      !
307      DO jn = 1, jptra
308         ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
309         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
310         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
311         IF( lk_mpp ) THEN
312            CALL mpp_min( zmin )      ! min over the global domain
313            CALL mpp_max( zmax )      ! max over the global domain
314         END IF
315         zmean  = ztraf / areatot
316         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp
317         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
318      END DO
319      WRITE(numout,*) 
3209000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
321      &      '    max :',e18.10,'    drift :',e18.10, ' %')
322      !
323   END SUBROUTINE trc_rst_stat
324
325#else
326   !!----------------------------------------------------------------------
327   !!  Dummy module :                                     No passive tracer
328   !!----------------------------------------------------------------------
329CONTAINS
330   SUBROUTINE trc_rst_read                      ! Empty routines
331   END SUBROUTINE trc_rst_read
332   SUBROUTINE trc_rst_wri( kt )
333      INTEGER, INTENT ( in ) :: kt
334      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
335   END SUBROUTINE trc_rst_wri   
336#endif
337
338   !!----------------------------------------------------------------------
339   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
340   !! $Id$
341   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
342   !!======================================================================
343END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.