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 @ 6753

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

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