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

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

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