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

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

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