source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcrst.F90 @ 10963

Last change on this file since 10963 was 10963, checked in by acc, 19 months ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert TOP routines in top-level TOP directory and all knock on effects of these conversions. SETTE tested.

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