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

source: NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcrst.F90 @ 13463

Last change on this file since 13463 was 13463, checked in by andmirek, 4 years ago

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