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/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/TOP – NEMO

source: NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/TOP/trcrst.F90 @ 13987

Last change on this file since 13987 was 13987, checked in by cetlod, 4 years ago

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