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

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

Bug fixes from Tim's local GO6 package to fix age tracer output file naming

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