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

source: branches/UKMO/dev_r5518_medusa_fix_restart/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 7869

Last change on this file since 7869 was 7869, checked in by marc, 7 years ago

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