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

Last change on this file since 6201 was 6201, checked in by jpalmier, 6 years ago

JPALM — 04-01-2016 — add debugg prints under debugg_key

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