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_r13333_TOP-05_Ethe_Agrif/src/TOP – NEMO

source: NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcrst.F90 @ 13373

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

TOP-05_Ethe_Agrif : 1st step of changes to successfully compile, see ticket #2508
  • Property svn:keywords set to Id
File size: 16.6 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               ! parameters corresponding to nit000 - 1 (as we start the step
262               ! loop with a call to day)
263               ndastp = ndate0 - 1       ! ndate0 read in the namelist in dom_nam
264               nhour   =   nn_time0 / 100
265               nminute = ( nn_time0 - nhour * 100 )
266               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
267               adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday
268               ! note this is wrong if time step has changed during run
269            ENDIF
270            IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
271            !
272            IF(lwp) THEN
273              WRITE(numout,*) ' *** Info used values : '
274              WRITE(numout,*) '   date ndastp                                      : ', ndastp
275              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
276              WRITE(numout,*) '   nn_time0                                         : ', nn_time0
277              WRITE(numout,*)
278            ENDIF
279            !
280            IF( ln_rsttr )  THEN   ;    l_1st_euler = .false.
281            ELSE                   ;    l_1st_euler = .true.
282            ENDIF
283            !
284            CALL day_init          ! compute calendar
285            !
286         ENDIF
287         !
288      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
289         !
290         IF(  kt == nitrst ) THEN
291            IF(lwp) WRITE(numout,*)
292            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
293            IF(lwp) WRITE(numout,*) '~~~~~~~'
294         ENDIF
295         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
296         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
297         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
298         !                                                                     ! the begining of the run [s]
299         CALL iom_rstput( kt, nitrst, numrtw, 'ntime'  , REAL( nn_time0, wp)) ! time
300      ENDIF
301
302   END SUBROUTINE trc_rst_cal
303
304
305   SUBROUTINE trc_rst_stat( Kmm, Krhs )
306      !!----------------------------------------------------------------------
307      !!                    ***  trc_rst_stat  ***
308      !!
309      !! ** purpose  :   Compute tracers statistics
310      !!----------------------------------------------------------------------
311      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices
312      INTEGER  :: jk, jn
313      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
314      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
315      !!----------------------------------------------------------------------
316
317      IF( lwp ) THEN
318         WRITE(numout,*) 
319         WRITE(numout,*) '           ----TRACER STAT----             '
320         WRITE(numout,*) 
321      ENDIF
322      !
323      DO jk = 1, jpk
324         zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Krhs) * tmask(:,:,jk)
325      END DO
326      !
327      DO jn = 1, jptra
328         ztraf = glob_sum( 'trcrst', tr(:,:,:,jn,Kmm) * zvol(:,:,:) )
329         zmin  = MINVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
330         zmax  = MAXVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
331         IF( lk_mpp ) THEN
332            CALL mpp_min( 'trcrst', zmin )      ! min over the global domain
333            CALL mpp_max( 'trcrst', zmax )      ! max over the global domain
334         END IF
335         zmean  = ztraf / areatot
336         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp
337         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
338      END DO
339      IF(lwp) WRITE(numout,*) 
3409000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
341      &      '    max :',e18.10,'    drift :',e18.10, ' %')
342      !
343   END SUBROUTINE trc_rst_stat
344
345#else
346   !!----------------------------------------------------------------------
347   !!  Dummy module :                                     No passive tracer
348   !!----------------------------------------------------------------------
349CONTAINS
350   SUBROUTINE trc_rst_read( Kbb, Kmm)                      ! Empty routines
351      INTEGER, INTENT( in ) :: Kbb, Kmm  ! time level indices
352   END SUBROUTINE trc_rst_read
353   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs )
354      INTEGER, INTENT( in ) :: kt
355      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices
356      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
357   END SUBROUTINE trc_rst_wri   
358#endif
359
360   !!----------------------------------------------------------------------
361   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
362   !! $Id$
363   !! Software governed by the CeCILL license (see ./LICENSE)
364   !!======================================================================
365END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.