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 branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 7795

Last change on this file since 7795 was 7256, checked in by cbricaud, 7 years ago

phaze NEMO routines in CRS branch with nemo_v3_6_STABLE branch at rev 7213 (09-09-2016) (merge -r 5519:7213 )
  • Property svn:keywords set to Id
File size: 14.8 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   !!----------------------------------------------------------------------
18   !!----------------------------------------------------------------------
19   !!   'key_top'                                                TOP models
20   !!----------------------------------------------------------------------
21   !!   trc_rst_opn    : open  restart file
22   !!   trc_rst_read   : read  restart file
23   !!   trc_rst_wri    : write restart file
24   !!----------------------------------------------------------------------
25   USE oce_trc ! ,ONLY: jprstlib
26   USE trc
27   USE trcnam_trp
28   USE iom_def , ONLY : jprstlib , jprstdimg , jpnf90 , jpdom_autoglo 
29   USE iom , ONLY : iom_open , iom_get , iom_varid , iom_rstput , iom_close
30   USE dom_oce, ONLY: ndastp ,adatrj  , rdttra
31   USE daymod , ONLY : day_init
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   trc_rst_opn       ! called by ???
37   PUBLIC   trc_rst_read      ! called by ???
38   PUBLIC   trc_rst_wri       ! called by ???
39   PUBLIC   trc_rst_cal
40
41   !! * Substitutions
42#  include "top_substitute.h90"
43   
44CONTAINS
45   
46   SUBROUTINE trc_rst_opn( kt )
47      !!----------------------------------------------------------------------
48      !!                    ***  trc_rst_opn  ***
49      !!
50      !! ** purpose  :   output of sea-trc variable in a netcdf file
51      !!----------------------------------------------------------------------
52      INTEGER, INTENT(in) ::   kt       ! number of iteration
53      !
54      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
55      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
56      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
57      !!----------------------------------------------------------------------
58      !
59      IF( lk_offline ) THEN
60         IF( kt == nittrc000 ) THEN
61            lrst_trc = .FALSE.
62            IF( ln_rst_list ) THEN
63               nrst_lst = 1
64               nitrst = nstocklist( nrst_lst )
65            ELSE
66               nitrst = nitend
67            ENDIF
68         ENDIF
69
70         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
71            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
72            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
73            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
74         ENDIF
75      ELSE
76         IF( kt == nittrc000 ) lrst_trc = .FALSE.
77      ENDIF
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 - 2*nn_dttrc + 1)
81      ! 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
82      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .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., kiolib = jprstlib )
95         lrst_trc = .TRUE.
96      ENDIF
97      !
98   END SUBROUTINE trc_rst_opn
99
100   SUBROUTINE trc_rst_read
101      !!----------------------------------------------------------------------
102      !!                    ***  trc_rst_opn  ***
103      !!
104      !! ** purpose  :   read passive tracer fields in restart files
105      !!----------------------------------------------------------------------
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_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
117      END DO
118
119      DO jn = 1, jptra
120         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
121      END DO
122      !
123   END SUBROUTINE trc_rst_read
124
125   SUBROUTINE trc_rst_wri( kt )
126      !!----------------------------------------------------------------------
127      !!                    ***  trc_rst_wri  ***
128      !!
129      !! ** purpose  :   write passive tracer fields in restart files
130      !!----------------------------------------------------------------------
131      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
132      !!
133      INTEGER  :: jn
134      REAL(wp) :: zarak0
135      !!----------------------------------------------------------------------
136      !
137      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step
138      ! prognostic variables
139      ! --------------------
140      DO jn = 1, jptra
141         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
142      END DO
143
144      DO jn = 1, jptra
145         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
146      END DO
147      !
148      IF( kt == nitrst ) THEN
149          CALL trc_rst_stat            ! statistics
150          CALL iom_close( numrtw )     ! close the restart file (only at last time step)
151#if ! defined key_trdmld_trc
152          lrst_trc = .FALSE.
153#endif
154          IF( lk_offline .AND. ln_rst_list ) THEN
155             nrst_lst = nrst_lst + 1
156             nitrst = nstocklist( nrst_lst )
157          ENDIF
158      ENDIF
159      !
160   END SUBROUTINE trc_rst_wri 
161
162
163   SUBROUTINE trc_rst_cal( kt, cdrw )
164      !!---------------------------------------------------------------------
165      !!                   ***  ROUTINE trc_rst_cal  ***
166      !!
167      !!  ** Purpose : Read or write calendar in restart file:
168      !!
169      !!  WRITE(READ) mode:
170      !!       kt        : number of time step since the begining of the experiment at the
171      !!                   end of the current(previous) run
172      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
173      !!                   end of the current(previous) run (REAL -> keep fractions of day)
174      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
175      !!
176      !!   According to namelist parameter nrstdt,
177      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
178      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
179      !!                   time step of previous run + 1.
180      !!       In both those options, the  exact duration of the experiment
181      !!       since the beginning (cumulated duration of all previous restart runs)
182      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt.
183      !!       This is valid is the time step has remained constant.
184      !!
185      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
186      !!                    has been stored in the restart file.
187      !!----------------------------------------------------------------------
188      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
189      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
190      !
191      INTEGER  ::  jlibalt = jprstlib
192      LOGICAL  ::  llok
193      REAL(wp) ::  zkt, zrdttrc1
194      REAL(wp) ::  zndastp
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 ( jprstlib == jprstdimg ) THEN
206           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
207           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
208           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
209           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
210         ENDIF
211
212         IF( ln_rsttr ) THEN
213            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
214            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
215
216            IF(lwp) THEN
217               WRITE(numout,*) ' *** Info read in restart : '
218               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
219               WRITE(numout,*) ' *** restart option'
220               SELECT CASE ( nn_rsttr )
221               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
222               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
223               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
224               END SELECT
225               WRITE(numout,*)
226            ENDIF
227            ! Control of date
228            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
229               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
230               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
231         ENDIF
232         !
233         IF( lk_offline ) THEN   
234            !                                          ! set the date in offline mode
235            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
236               CALL iom_get( numrtr, 'ndastp', zndastp ) 
237               ndastp = NINT( zndastp )
238               CALL iom_get( numrtr, 'adatrj', adatrj  )
239             ELSE
240               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
241               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
242               ! note this is wrong if time step has changed during run
243            ENDIF
244            !
245            IF(lwp) THEN
246              WRITE(numout,*) ' *** Info used values : '
247              WRITE(numout,*) '   date ndastp                                      : ', ndastp
248              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
249              WRITE(numout,*)
250            ENDIF
251            !
252            IF( ln_rsttr )  THEN   ;    neuler = 1
253            ELSE                   ;    neuler = 0
254            ENDIF
255            !
256            CALL day_init          ! compute calendar
257            !
258         ENDIF
259         !
260      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
261         !
262         IF(  kt == nitrst ) THEN
263            IF(lwp) WRITE(numout,*)
264            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
265            IF(lwp) WRITE(numout,*) '~~~~~~~'
266         ENDIF
267         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
268         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
269         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
270         !                                                                     ! the begining of the run [s]
271      ENDIF
272
273   END SUBROUTINE trc_rst_cal
274
275
276   SUBROUTINE trc_rst_stat
277      !!----------------------------------------------------------------------
278      !!                    ***  trc_rst_stat  ***
279      !!
280      !! ** purpose  :   Compute tracers statistics
281      !!----------------------------------------------------------------------
282      INTEGER  :: jk, jn
283      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
284      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
285      !!----------------------------------------------------------------------
286
287      IF( lwp ) THEN
288         WRITE(numout,*) 
289         WRITE(numout,*) '           ----TRACER STAT----             '
290         WRITE(numout,*) 
291      ENDIF
292      !
293      DO jk = 1, jpk
294         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
295      END DO
296      !
297      DO jn = 1, jptra
298         ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
299         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
300         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
301         IF( lk_mpp ) THEN
302            CALL mpp_min( zmin )      ! min over the global domain
303            CALL mpp_max( zmax )      ! max over the global domain
304         END IF
305         zmean  = ztraf / areatot
306         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp
307         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
308      END DO
309      IF(lwp) WRITE(numout,*) 
3109000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
311      &      '    max :',e18.10,'    drift :',e18.10, ' %')
312      !
313   END SUBROUTINE trc_rst_stat
314
315#else
316   !!----------------------------------------------------------------------
317   !!  Dummy module :                                     No passive tracer
318   !!----------------------------------------------------------------------
319CONTAINS
320   SUBROUTINE trc_rst_read                      ! Empty routines
321   END SUBROUTINE trc_rst_read
322   SUBROUTINE trc_rst_wri( kt )
323      INTEGER, INTENT ( in ) :: kt
324      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
325   END SUBROUTINE trc_rst_wri   
326#endif
327
328   !!----------------------------------------------------------------------
329   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
330   !! $Id$
331   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
332   !!======================================================================
333END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.