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

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

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