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

source: branches/DEV_r1784_mid_year_merge_2010/NEMO/TOP_SRC/trcrst.F90 @ 1970

Last change on this file since 1970 was 1970, checked in by acc, 14 years ago

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