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

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

JPALM -- 21-01-2016 -- fix ideal-tracer bug - mispelled the iom_varid variable called

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