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/releases/r4.0/r4.0-HEAD/src/TOP – NEMO

source: NEMO/releases/r4.0/r4.0-HEAD/src/TOP/trcrst.F90

Last change on this file was 15810, checked in by smasson, 2 years ago

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