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

source: branches/DEV_r2460_v3_3beta_NOL/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 2461

Last change on this file since 2461 was 2457, checked in by cetlod, 14 years ago

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