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

source: branches/NERC/dev_r5518_NOC_unchanged/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 6244

Last change on this file since 6244 was 6244, checked in by jpalmier, 8 years ago

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