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/nemo_v3_3_beta/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 2287

Last change on this file since 2287 was 2287, checked in by smasson, 14 years ago

update licence of all NEMO files...
  • Property svn:keywords set to Id
File size: 16.0 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
26   USE trc
27   USE trcnam_trp
28   USE lib_mpp
29   USE iom
30   USE trcrst_cfc      ! CFC     
31   USE trcrst_lobster  ! LOBSTER  restart
32   USE trcrst_pisces   ! PISCES   restart
33   USE trcrst_c14b     ! C14 bomb restart
34   USE trcrst_my_trc   ! MY_TRC   restart
35#if defined key_offline
36    USE daymod
37#endif
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC   trc_rst_opn       ! called by ???
42   PUBLIC   trc_rst_read      ! called by ???
43   PUBLIC   trc_rst_wri       ! called by ???
44
45   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write)
46
47   !! * Substitutions
48#  include "top_substitute.h90"
49   
50CONTAINS
51   
52   SUBROUTINE trc_rst_opn( kt )
53      !!----------------------------------------------------------------------
54      !!                    ***  trc_rst_opn  ***
55      !!
56      !! ** purpose  :   output of sea-trc variable in a netcdf file
57      !!----------------------------------------------------------------------
58      INTEGER, INTENT(in) ::   kt       ! number of iteration
59      !
60      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
61      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
62      !!----------------------------------------------------------------------
63      !
64# if ! defined key_offline
65      IF( kt == nit000 ) lrst_trc = .FALSE. 
66# else
67      IF( kt == nit000 ) THEN
68        lrst_trc = .FALSE. 
69        nitrst = nitend 
70      ENDIF
71
72      IF( MOD( kt - 1, nstock ) == 0 ) THEN
73         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
74         nitrst = kt + nstock - 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# endif
78     ! to get better performances with NetCDF format:
79     ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
80     ! 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
81     IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1 .AND. .NOT. lrst_trc ) ) THEN
82         ! beware of the format used to write kt (default is i8.8, that should be large enough)
83         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
84         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
85         ENDIF
86         ! create the file
87         IF(lwp) WRITE(numout,*)
88         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
89         IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname
90         CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib )
91         lrst_trc = .TRUE.
92      ENDIF
93      !
94   END SUBROUTINE trc_rst_opn
95
96   SUBROUTINE trc_rst_read
97      !!----------------------------------------------------------------------
98      !!                    ***  trc_rst_opn  ***
99      !!
100      !! ** purpose  :   read passive tracer fields in restart files
101      !!----------------------------------------------------------------------
102      INTEGER  ::  jn     
103      INTEGER  ::  iarak0 
104      REAL(wp) ::  zarak0
105      INTEGER  ::  jlibalt = jprstlib
106      LOGICAL  ::  llok
107
108      !!----------------------------------------------------------------------
109
110      IF(lwp) WRITE(numout,*)
111      IF(lwp) WRITE(numout,*) 'trc_rst_read : read the TOP restart file'
112      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
113
114      IF ( jprstlib == jprstdimg ) THEN
115        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
116        ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
117        INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
118        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
119      ENDIF
120
121      CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 
122
123      ! Time domain : restart
124      ! ---------------------
125      CALL trc_rst_cal( nit000, 'READ' )   ! calendar
126
127      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   iarak0 = 1
128      ELSE                                           ;   iarak0 = 0
129      ENDIF
130      CALL iom_get( numrtr, 'arak0', zarak0 )
131
132      IF( iarak0 /= NINT( zarak0 ) )   &                           ! Control of the scheme
133         & CALL ctl_stop( ' ===>>>> : problem with advection scheme', &
134         & ' it must be the same type for both restart and previous run', &
135         & ' centered or euler '  )
136      IF(lwp) WRITE(numout,*)
137      IF(lwp) WRITE(numout,*) '    arakawa option      : ', NINT( zarak0 )
138
139      ! READ prognostic variables and computes diagnostic variable
140      DO jn = 1, jptra
141         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
142      END DO
143
144      DO jn = 1, jptra
145         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
146      END DO
147
148      IF( lk_lobster )   CALL trc_rst_read_lobster( numrtr )      ! LOBSTER bio-model
149      IF( lk_pisces  )   CALL trc_rst_read_pisces ( numrtr )      ! PISCES  bio-model
150      IF( lk_cfc     )   CALL trc_rst_read_cfc    ( numrtr )      ! CFC     tracers
151      IF( lk_c14b    )   CALL trc_rst_read_c14b   ( numrtr )      ! C14 bomb  tracer
152      IF( lk_my_trc  )   CALL trc_rst_read_my_trc ( numrtr )      ! MY_TRC  tracers
153
154      CALL iom_close( numrtr )
155      !
156   END SUBROUTINE trc_rst_read
157
158   SUBROUTINE trc_rst_wri( kt )
159      !!----------------------------------------------------------------------
160      !!                    ***  trc_rst_wri  ***
161      !!
162      !! ** purpose  :   write passive tracer fields in restart files
163      !!----------------------------------------------------------------------
164      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
165      !!
166      INTEGER  :: jn
167      REAL(wp) :: zarak0
168      !!----------------------------------------------------------------------
169
170
171      CALL trc_rst_cal( kt, 'WRITE' )   ! calendar
172
173      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   zarak0 = 1.
174      ELSE                                           ;   zarak0 = 0.
175      ENDIF
176      CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 )
177
178      ! prognostic variables
179      ! --------------------
180      DO jn = 1, jptra
181         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
182      END DO
183
184      DO jn = 1, jptra
185         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
186      END DO
187
188      IF( lk_lobster )   CALL trc_rst_wri_lobster( kt, nitrst, numrtw )      ! LOBSTER bio-model
189      IF( lk_pisces  )   CALL trc_rst_wri_pisces ( kt, nitrst, numrtw )      ! PISCES  bio-model
190      IF( lk_cfc     )   CALL trc_rst_wri_cfc    ( kt, nitrst, numrtw )      ! CFC     tracers
191      IF( lk_c14b    )   CALL trc_rst_wri_c14b   ( kt, nitrst, numrtw )      ! C14 bomb  tracer
192      IF( lk_my_trc  )   CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw )      ! MY_TRC  tracers
193
194      IF( kt == nitrst ) THEN
195          CALL trc_rst_stat            ! statistics
196          CALL iom_close( numrtw )     ! close the restart file (only at last time step)
197#if ! defined key_trdmld_trc
198          lrst_trc = .FALSE.
199#endif
200      ENDIF
201      !
202   END SUBROUTINE trc_rst_wri 
203
204
205   SUBROUTINE trc_rst_cal( kt, cdrw )
206      !!---------------------------------------------------------------------
207      !!                   ***  ROUTINE trc_rst_cal  ***
208      !!
209      !!  ** Purpose : Read or write calendar in restart file:
210      !!
211      !!  WRITE(READ) mode:
212      !!       kt        : number of time step since the begining of the experiment at the
213      !!                   end of the current(previous) run
214      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
215      !!                   end of the current(previous) run (REAL -> keep fractions of day)
216      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
217      !!
218      !!   According to namelist parameter nrstdt,
219      !!       nn_rsttr = 0  no control on the date (nit000 is  arbitrary).
220      !!       nn_rsttr = 1  we verify that nit000 is equal to the last
221      !!                   time step of previous run + 1.
222      !!       In both those options, the  exact duration of the experiment
223      !!       since the beginning (cumulated duration of all previous restart runs)
224      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
225      !!       This is valid is the time step has remained constant.
226      !!
227      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
228      !!                    has been stored in the restart file.
229      !!----------------------------------------------------------------------
230      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
231      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
232      !
233      REAL(wp) ::  zkt
234#if defined key_offline
235      REAL(wp) ::  zndastp
236#endif
237
238      ! Time domain : restart
239      ! ---------------------
240
241      IF( TRIM(cdrw) == 'READ' ) THEN
242         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
243         IF(lwp) THEN
244            WRITE(numout,*) ' *** Info read in restart : '
245            WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
246            WRITE(numout,*) ' *** restart option'
247            SELECT CASE ( nn_rsttr )
248            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000'
249            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
250            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
251            END SELECT
252            WRITE(numout,*)
253         ENDIF
254         ! Control of date
255         IF( nit000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  &
256            &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
257            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
258#if defined key_offline
259         ! define ndastp and adatrj
260         IF ( nn_rsttr == 2 ) THEN
261            CALL iom_get( numrtr, 'ndastp', zndastp ) 
262            ndastp = NINT( zndastp )
263            CALL iom_get( numrtr, 'adatrj', adatrj  )
264         ELSE
265            ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
266            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
267            ! note this is wrong if time step has changed during run
268         ENDIF
269         !
270         IF(lwp) THEN
271           WRITE(numout,*) ' *** Info used values : '
272           WRITE(numout,*) '   date ndastp                                      : ', ndastp
273           WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
274           WRITE(numout,*)
275         ENDIF
276         !
277         CALL day_init          ! compute calendar
278         !
279#endif
280
281      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
282         !
283         IF(  kt == nitrst ) THEN
284            IF(lwp) WRITE(numout,*)
285            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
286            IF(lwp) WRITE(numout,*) '~~~~~~~'
287         ENDIF
288         ! calendar control
289         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
290         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
291         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
292         !                                                                     ! the begining of the run [s]
293      ENDIF
294
295   END SUBROUTINE trc_rst_cal
296
297
298   SUBROUTINE trc_rst_stat
299      !!----------------------------------------------------------------------
300      !!                    ***  trc_rst_stat  ***
301      !!
302      !! ** purpose  :   Compute tracers statistics
303      !!----------------------------------------------------------------------
304
305      INTEGER  :: ji, jj, jk, jn
306      REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot
307      REAL(wp) :: zder, zvol
308      !!----------------------------------------------------------------------
309
310
311      IF( lwp ) THEN
312         WRITE(numout,*) 
313         WRITE(numout,*) '           ----TRACER STAT----             '
314         WRITE(numout,*) 
315      ENDIF
316     
317      zdiag_tot = 0.e0
318      DO jn = 1, jptra
319         zdiag_var    = 0.e0
320         zdiag_varmin = 0.e0
321         zdiag_varmax = 0.e0
322         DO jk = 1, jpk
323            DO jj = 1, jpj
324               DO ji = 1, jpi
325                  zvol = cvol(ji,jj,jk)
326#  if defined key_degrad
327                  zvol = zvol * facvol(ji,jj,jk)
328#  endif
329                  zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * zvol
330               END DO
331            END DO
332         END DO
333         
334         zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
335         zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
336         IF( lk_mpp ) THEN
337            CALL mpp_min( zdiag_varmin )      ! min over the global domain
338            CALL mpp_max( zdiag_varmax )      ! max over the global domain
339            CALL mpp_sum( zdiag_var    )      ! sum over the global domain
340         END IF
341         zdiag_tot = zdiag_tot + zdiag_var
342         zdiag_var = zdiag_var / areatot
343         IF(lwp) WRITE(numout,*) '   MEAN NO ', jn, ctrcnm(jn), ' = ', zdiag_var,   &
344            &                    ' MIN = ', zdiag_varmin, ' MAX = ', zdiag_varmax
345      END DO
346     
347      zder = ( ( zdiag_tot - trai ) / ( trai + 1.e-12 )  ) * 100._wp
348      IF(lwp) WRITE(numout,*) '   Integral of all tracers over the full domain  = ', zdiag_tot
349      IF(lwp) WRITE(numout,*) '   Drift of the sum of all tracers =', zder, ' %'
350     
351   END SUBROUTINE trc_rst_stat
352
353#else
354   !!----------------------------------------------------------------------
355   !!  Dummy module :                                     No passive tracer
356   !!----------------------------------------------------------------------
357CONTAINS
358   SUBROUTINE trc_rst_read                      ! Empty routines
359   END SUBROUTINE trc_rst_read
360   SUBROUTINE trc_rst_wri( kt )
361      INTEGER, INTENT ( in ) :: kt
362      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
363   END SUBROUTINE trc_rst_wri   
364#endif
365
366   !!----------------------------------------------------------------------
367   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
368   !! $Id$
369   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
370   !!======================================================================
371END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.