source: branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_8356/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 9073

Last change on this file since 9073 was 9073, checked in by jpalmier, 3 years ago

add all micro boil checks and securities

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