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

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.

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