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

source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 6160

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

JPALM -- 22-12-2015 -- adapt trc restart name with the good date
File size: 26.5 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   !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs
32   USE sms_medusa
33   USE trcsms_medusa
34   !!
35   IMPLICIT NONE
36   PRIVATE
37
38   PUBLIC   trc_rst_opn       ! called by ???
39   PUBLIC   trc_rst_read      ! called by ???
40   PUBLIC   trc_rst_wri       ! called by ???
41   PUBLIC   trc_rst_cal
42
43   !! * Substitutions
44#  include "top_substitute.h90"
45   
46CONTAINS
47   
48   SUBROUTINE trc_rst_opn( kt )
49      !!----------------------------------------------------------------------
50      !!                    ***  trc_rst_opn  ***
51      !!
52      !! ** purpose  :   output of sea-trc variable in a netcdf file
53      !!----------------------------------------------------------------------
54      INTEGER, INTENT(in) ::   kt       ! number of iteration
55      INTEGER             ::   iyear, imonth, iday
56      REAL (wp)           ::   zsec
57      !
58      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
59      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
60      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
61      !!----------------------------------------------------------------------
62      !
63      IF( lk_offline ) THEN
64         IF( kt == nittrc000 ) THEN
65            lrst_trc = .FALSE.
66            IF( ln_rst_list ) THEN
67               nrst_lst = 1
68               nitrst = nstocklist( nrst_lst )
69            ELSE
70               nitrst = nitend
71            ENDIF
72         ENDIF
73
74         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
75            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
76            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
77            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
78         ENDIF
79      ELSE
80         IF( kt == nittrc000 ) lrst_trc = .FALSE.
81      ENDIF
82
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*nn_dttrc + 1)
85      ! 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
86      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
87         IF ( ln_rstdate ) THEN
88            !! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name
89            !!                     -- the condition to open the rst file is not the same than for the dynamic rst.
90            !!                     -- here it - for an obscure reason - is open 2 time-step before the restart writing process
91            !!                     instead of 1.
92            !!                     -- i am not sure if someone forgot +1 in the if loop condition as
93            !!                     it is writen in all comments nitrst - 2*nn_dttrc + 1 and the condition is nitrst - 2*nn_dttrc
94            !!                     -- nevertheless we didn't wanted to broke something already working
95            !!                     and just adapted the part we added.
96            !!                     -- So instead of calling ju2ymds( fjulday + (rdttra(1)) ....
97            !!                     we call ju2ymds( fjulday + (2*rdttra(1)) .....
98            !!--------------------------------------------------------------------     
99            CALL ju2ymds( fjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec )
100            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
101         ELSE
102            ! beware of the format used to write kt (default is i8.8, that should be large enough)
103            IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
104            ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
105            ENDIF
106         ENDIF
107         ! create the file
108         IF(lwp) WRITE(numout,*)
109         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
110         clpath = TRIM(cn_trcrst_outdir)
111         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
112         IF(lwp) WRITE(numout,*) &
113             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname
114         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
115         lrst_trc = .TRUE.
116      ENDIF
117      !
118   END SUBROUTINE trc_rst_opn
119
120   SUBROUTINE trc_rst_read
121      !!----------------------------------------------------------------------
122      !!                    ***  trc_rst_opn  ***
123      !!
124      !! ** purpose  :   read passive tracer fields in restart files
125      !!----------------------------------------------------------------------
126      INTEGER  ::  jn     
127      !! AXY (05/11/13): temporary variables
128      REAL(wp) ::    fq0,fq1,fq2
129
130      !!----------------------------------------------------------------------
131      !
132      IF(lwp) WRITE(numout,*)
133      IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
134      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
135
136      ! READ prognostic variables and computes diagnostic variable
137      DO jn = 1, jptra
138         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
139      END DO
140
141      DO jn = 1, jptra
142         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
143      END DO
144
145      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
146      !!                 call to MEDUSA-2 at this point; this suggests that the FCM
147      !!                 version of NEMO date significantly earlier than the current
148      !!                 version
149
150#if defined key_medusa
151      !! AXY (13/01/12): check if the restart contains sediment fields;
152      !!                 this is only relevant for simulations that include
153      !!                 biogeochemistry and are restarted from earlier runs
154      !!                 in which there was no sediment component
155      !!
156      IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN
157         !! YES; in which case read them
158         !!
159         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...'
160         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N',  zb_sed_n(:,:)  )
161         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N',  zn_sed_n(:,:)  )
162         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) )
163         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) )
164         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) )
165         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) )
166         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C',  zb_sed_c(:,:)  )
167         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C',  zn_sed_c(:,:)  )
168         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) )
169         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) )
170      ELSE
171         !! NO; in which case set them to zero
172         !!
173         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...'
174         zb_sed_n(:,:)  = 0.0   !! organic N
175         zn_sed_n(:,:)  = 0.0
176         zb_sed_fe(:,:) = 0.0   !! organic Fe
177         zn_sed_fe(:,:) = 0.0
178         zb_sed_si(:,:) = 0.0   !! inorganic Si
179         zn_sed_si(:,:) = 0.0
180         zb_sed_c(:,:)  = 0.0   !! organic C
181         zn_sed_c(:,:)  = 0.0
182         zb_sed_ca(:,:) = 0.0   !! inorganic C
183         zn_sed_ca(:,:) = 0.0
184      ENDIF
185      !!
186      !! calculate stats on these fields
187      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
188      fq0 = MINVAL(zn_sed_n(:,:))
189      fq1 = MAXVAL(zn_sed_n(:,:))
190      fq2 = SUM(zn_sed_n(:,:))
191      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', &
192         &        fq0, fq1, fq2
193      fq0 = MINVAL(zn_sed_fe(:,:))
194      fq1 = MAXVAL(zn_sed_fe(:,:))
195      fq2 = SUM(zn_sed_fe(:,:))
196      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
197         &        fq0, fq1, fq2
198      fq0 = MINVAL(zn_sed_si(:,:))
199      fq1 = MAXVAL(zn_sed_si(:,:))
200      fq2 = SUM(zn_sed_si(:,:))
201      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
202         &        fq0, fq1, fq2
203      fq0 = MINVAL(zn_sed_c(:,:))
204      fq1 = MAXVAL(zn_sed_c(:,:))
205      fq2 = SUM(zn_sed_c(:,:))
206      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', &
207         &        fq0, fq1, fq2
208      fq0 = MINVAL(zn_sed_ca(:,:))
209      fq1 = MAXVAL(zn_sed_ca(:,:))
210      fq2 = SUM(zn_sed_ca(:,:))
211      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
212         &        fq0, fq1, fq2
213      !!
214      !! AXY (07/07/15): read in temporally averaged fields for DMS
215      !!                 calculations
216      !!
217      IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN
218         !! YES; in which case read them
219         !!
220         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...'
221         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
222         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
223         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
224         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
225         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
226         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
227         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
228         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
229         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN',  zb_dms_din(:,:)  )
230         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN',  zn_dms_din(:,:)  )
231      ELSE
232         !! NO; in which case set them to zero
233         !!
234         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...'
235         zb_dms_chn(:,:)  = 0.0   !! CHN
236         zn_dms_chn(:,:)  = 0.0
237         zb_dms_chd(:,:)  = 0.0   !! CHD
238         zn_dms_chd(:,:)  = 0.0
239         zb_dms_mld(:,:)  = 0.0   !! MLD
240         zn_dms_mld(:,:)  = 0.0
241         zb_dms_qsr(:,:)  = 0.0   !! QSR
242         zn_dms_qsr(:,:)  = 0.0
243         zb_dms_din(:,:)  = 0.0   !! DIN
244         zn_dms_din(:,:)  = 0.0
245      ENDIF
246      !!
247      !! calculate stats on these fields
248      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
249      fq0 = MINVAL(zn_dms_chn(:,:))
250      fq1 = MAXVAL(zn_dms_chn(:,:))
251      fq2 = SUM(zn_dms_chn(:,:))
252      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2
253      fq0 = MINVAL(zn_dms_chd(:,:))
254      fq1 = MAXVAL(zn_dms_chd(:,:))
255      fq2 = SUM(zn_dms_chd(:,:))
256      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2
257      fq0 = MINVAL(zn_dms_mld(:,:))
258      fq1 = MAXVAL(zn_dms_mld(:,:))
259      fq2 = SUM(zn_dms_mld(:,:))
260      if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2
261      fq0 = MINVAL(zn_dms_qsr(:,:))
262      fq1 = MAXVAL(zn_dms_qsr(:,:))
263      fq2 = SUM(zn_dms_qsr(:,:))
264      if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2
265      fq0 = MINVAL(zn_dms_din(:,:))
266      fq1 = MAXVAL(zn_dms_din(:,:))
267      fq2 = SUM(zn_dms_din(:,:))
268      if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2
269
270#endif
271 
272      !
273   END SUBROUTINE trc_rst_read
274
275   SUBROUTINE trc_rst_wri( kt )
276      !!----------------------------------------------------------------------
277      !!                    ***  trc_rst_wri  ***
278      !!
279      !! ** purpose  :   write passive tracer fields in restart files
280      !!----------------------------------------------------------------------
281      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
282      !!
283      INTEGER  :: jn
284      REAL(wp) :: zarak0
285      !! AXY (05/11/13): temporary variables
286      REAL(wp) ::    fq0,fq1,fq2
287      !!----------------------------------------------------------------------
288      !
289      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step
290      ! prognostic variables
291      ! --------------------
292      DO jn = 1, jptra
293         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
294      END DO
295
296      DO jn = 1, jptra
297         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
298      END DO
299
300      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
301      !!                 call to MEDUSA-2 at this point; this suggests that the FCM
302      !!                 version of NEMO date significantly earlier than the current
303      !!                 version
304
305#if defined key_medusa
306      !! AXY (13/01/12): write out "before" and "now" state of seafloor
307      !!                 sediment pools into restart; this happens
308      !!                 whether or not the pools are to be used by
309      !!                 MEDUSA (which is controlled by a switch in the
310      !!                 namelist_top file)
311      !!
312      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...'
313      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N',  zb_sed_n(:,:)  )
314      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N',  zn_sed_n(:,:)  )
315      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) )
316      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) )
317      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) )
318      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) )
319      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C',  zb_sed_c(:,:)  )
320      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C',  zn_sed_c(:,:)  )
321      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) )
322      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) )
323      !!
324      !! calculate stats on these fields
325      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
326      fq0 = MINVAL(zn_sed_n(:,:))
327      fq1 = MAXVAL(zn_sed_n(:,:))
328      fq2 = SUM(zn_sed_n(:,:))
329      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', &
330         &        fq0, fq1, fq2
331      fq0 = MINVAL(zn_sed_fe(:,:))
332      fq1 = MAXVAL(zn_sed_fe(:,:))
333      fq2 = SUM(zn_sed_fe(:,:))
334      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
335         &        fq0, fq1, fq2
336      fq0 = MINVAL(zn_sed_si(:,:))
337      fq1 = MAXVAL(zn_sed_si(:,:))
338      fq2 = SUM(zn_sed_si(:,:))
339      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
340         &        fq0, fq1, fq2
341      fq0 = MINVAL(zn_sed_c(:,:))
342      fq1 = MAXVAL(zn_sed_c(:,:))
343      fq2 = SUM(zn_sed_c(:,:))
344      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', &
345         &        fq0, fq1, fq2
346      fq0 = MINVAL(zn_sed_ca(:,:))
347      fq1 = MAXVAL(zn_sed_ca(:,:))
348      fq2 = SUM(zn_sed_ca(:,:))
349      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
350         &        fq0, fq1, fq2
351      !!
352      !! AXY (07/07/15): write out temporally averaged fields for DMS
353      !!                 calculations
354      !!
355      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...'
356      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
357      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
358      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
359      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
360      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
361      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
362      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
363      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
364      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN',  zb_dms_din(:,:)  )
365      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN',  zn_dms_din(:,:)  )
366      !!
367      !! calculate stats on these fields
368      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
369      fq0 = MINVAL(zn_dms_chn(:,:))
370      fq1 = MAXVAL(zn_dms_chn(:,:))
371      fq2 = SUM(zn_dms_chn(:,:))
372      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2
373      fq0 = MINVAL(zn_dms_chd(:,:))
374      fq1 = MAXVAL(zn_dms_chd(:,:))
375      fq2 = SUM(zn_dms_chd(:,:))
376      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2
377      fq0 = MINVAL(zn_dms_mld(:,:))
378      fq1 = MAXVAL(zn_dms_mld(:,:))
379      fq2 = SUM(zn_dms_mld(:,:))
380      if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2
381      fq0 = MINVAL(zn_dms_qsr(:,:))
382      fq1 = MAXVAL(zn_dms_qsr(:,:))
383      fq2 = SUM(zn_dms_qsr(:,:))
384      if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2
385      fq0 = MINVAL(zn_dms_din(:,:))
386      fq1 = MAXVAL(zn_dms_din(:,:))
387      fq2 = SUM(zn_dms_din(:,:))
388      if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2
389      !!
390#endif
391
392      !
393      IF( kt == nitrst ) THEN
394          CALL trc_rst_stat            ! statistics
395          CALL iom_close( numrtw )     ! close the restart file (only at last time step)
396#if ! defined key_trdmxl_trc
397          lrst_trc = .FALSE.
398#endif
399          IF( lk_offline .AND. ln_rst_list ) THEN
400             nrst_lst = nrst_lst + 1
401             nitrst = nstocklist( nrst_lst )
402          ENDIF
403      ENDIF
404      !
405   END SUBROUTINE trc_rst_wri 
406
407
408   SUBROUTINE trc_rst_cal( kt, cdrw )
409      !!---------------------------------------------------------------------
410      !!                   ***  ROUTINE trc_rst_cal  ***
411      !!
412      !!  ** Purpose : Read or write calendar in restart file:
413      !!
414      !!  WRITE(READ) mode:
415      !!       kt        : number of time step since the begining of the experiment at the
416      !!                   end of the current(previous) run
417      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
418      !!                   end of the current(previous) run (REAL -> keep fractions of day)
419      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
420      !!
421      !!   According to namelist parameter nrstdt,
422      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
423      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
424      !!                   time step of previous run + 1.
425      !!       In both those options, the  exact duration of the experiment
426      !!       since the beginning (cumulated duration of all previous restart runs)
427      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt.
428      !!       This is valid is the time step has remained constant.
429      !!
430      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
431      !!                    has been stored in the restart file.
432      !!----------------------------------------------------------------------
433      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
434      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
435      !
436      INTEGER  ::  jlibalt = jprstlib
437      LOGICAL  ::  llok
438      REAL(wp) ::  zkt, zrdttrc1
439      REAL(wp) ::  zndastp
440
441      ! Time domain : restart
442      ! ---------------------
443
444      IF( TRIM(cdrw) == 'READ' ) THEN
445
446         IF(lwp) WRITE(numout,*)
447         IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
448         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
449
450         IF ( jprstlib == jprstdimg ) THEN
451           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
452           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
453           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
454           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
455         ENDIF
456
457         IF( ln_rsttr ) THEN
458            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
459            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
460
461            IF(lwp) THEN
462               WRITE(numout,*) ' *** Info read in restart : '
463               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
464               WRITE(numout,*) ' *** restart option'
465               SELECT CASE ( nn_rsttr )
466               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
467               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
468               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
469               END SELECT
470               WRITE(numout,*)
471            ENDIF
472            ! Control of date
473            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
474               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
475               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
476         ENDIF
477         !
478         IF( lk_offline ) THEN   
479            !                                          ! set the date in offline mode
480            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
481               CALL iom_get( numrtr, 'ndastp', zndastp ) 
482               ndastp = NINT( zndastp )
483               CALL iom_get( numrtr, 'adatrj', adatrj  )
484             ELSE
485               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
486               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
487               ! note this is wrong if time step has changed during run
488            ENDIF
489            !
490            IF(lwp) THEN
491              WRITE(numout,*) ' *** Info used values : '
492              WRITE(numout,*) '   date ndastp                                      : ', ndastp
493              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
494              WRITE(numout,*)
495            ENDIF
496            !
497            IF( ln_rsttr )  THEN   ;    neuler = 1
498            ELSE                   ;    neuler = 0
499            ENDIF
500            !
501            CALL day_init          ! compute calendar
502            !
503         ENDIF
504         !
505      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
506         !
507         IF(  kt == nitrst ) THEN
508            IF(lwp) WRITE(numout,*)
509            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
510            IF(lwp) WRITE(numout,*) '~~~~~~~'
511         ENDIF
512         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
513         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
514         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
515         !                                                                     ! the begining of the run [s]
516      ENDIF
517
518   END SUBROUTINE trc_rst_cal
519
520
521   SUBROUTINE trc_rst_stat
522      !!----------------------------------------------------------------------
523      !!                    ***  trc_rst_stat  ***
524      !!
525      !! ** purpose  :   Compute tracers statistics
526      !!----------------------------------------------------------------------
527      INTEGER  :: jk, jn
528      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
529      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
530      !!----------------------------------------------------------------------
531
532      IF( lwp ) THEN
533         WRITE(numout,*) 
534         WRITE(numout,*) '           ----TRACER STAT----             '
535         WRITE(numout,*) 
536      ENDIF
537      !
538      DO jk = 1, jpk
539         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
540      END DO
541      !
542      DO jn = 1, jptra
543         ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
544         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
545         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
546         IF( lk_mpp ) THEN
547            CALL mpp_min( zmin )      ! min over the global domain
548            CALL mpp_max( zmax )      ! max over the global domain
549         END IF
550         zmean  = ztraf / areatot
551         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp
552         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
553      END DO
554      WRITE(numout,*) 
5559000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
556      &      '    max :',e18.10,'    drift :',e18.10, ' %')
557      !
558   END SUBROUTINE trc_rst_stat
559
560#else
561   !!----------------------------------------------------------------------
562   !!  Dummy module :                                     No passive tracer
563   !!----------------------------------------------------------------------
564CONTAINS
565   SUBROUTINE trc_rst_read                      ! Empty routines
566   END SUBROUTINE trc_rst_read
567   SUBROUTINE trc_rst_wri( kt )
568      INTEGER, INTENT ( in ) :: kt
569      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
570   END SUBROUTINE trc_rst_wri   
571#endif
572
573   !!----------------------------------------------------------------------
574   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
575   !! $Id$
576   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
577   !!======================================================================
578END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.