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 @ 6109

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

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