source: branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc_3dnitbal/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 11990

Last change on this file since 11990 was 11990, checked in by dford, 8 months ago

Get the nitrogen balancing working with 3D chlorophyll increments.

File size: 44.0 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 par_medusa
33   USE sms_medusa
34   USE trcsms_medusa
35   !!
36#if defined key_idtra
37   USE trcsms_idtra
38#endif
39   !!
40#if defined key_cfc
41   USE trcsms_cfc
42#endif
43   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
44   USE sbc_oce, ONLY: lk_oasis 
45   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable
46   USE trcstat
47#if defined key_foam_medusa
48   USE obs_const, ONLY: obfillflt  ! Observation operator fill value
49#endif
50
51   IMPLICIT NONE
52   PRIVATE
53
54   PUBLIC   trc_rst_opn       ! called by ???
55   PUBLIC   trc_rst_read      ! called by ???
56   PUBLIC   trc_rst_wri       ! called by ???
57   PUBLIC   trc_rst_cal
58   PUBLIC   trc_rst_stat
59#if defined key_medusa && defined key_roam
60   PUBLIC   trc_rst_conserve
61#endif
62
63   !! * Substitutions
64#  include "top_substitute.h90"
65   
66CONTAINS
67   
68   SUBROUTINE trc_rst_opn( kt )
69      !!----------------------------------------------------------------------
70      !!                    ***  trc_rst_opn  ***
71      !!
72      !! ** purpose  :   output of sea-trc variable in a netcdf file
73      !!----------------------------------------------------------------------
74      INTEGER, INTENT(in) ::   kt       ! number of iteration
75      INTEGER             ::   iyear, imonth, iday
76      REAL (wp)           ::   zsec
77      REAL (wp)           ::   zfjulday
78      !
79      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
80      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
81      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
82      !!----------------------------------------------------------------------
83      !
84      IF( lk_offline ) THEN
85         IF( kt == nittrc000 ) THEN
86            lrst_trc = .FALSE.
87            IF( ln_rst_list ) THEN
88               nrst_lst = 1
89               nitrst = nstocklist( nrst_lst )
90            ELSE
91               nitrst = nitend
92            ENDIF
93         ENDIF
94
95         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
96            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
97            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
98            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
99         ENDIF
100      ELSE
101         IF( kt == nittrc000 ) lrst_trc = .FALSE.
102      ENDIF
103
104      ! to get better performances with NetCDF format:
105      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
106      ! 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
107      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
108         IF ( ln_rstdate ) THEN
109            !! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name
110            !!                     -- the condition to open the rst file is not the same than for the dynamic rst.
111            !!                     -- here it - for an obscure reason - is open 2 time-step before the restart writing process
112            !!                     instead of 1.
113            !!                     -- i am not sure if someone forgot +1 in the if loop condition as
114            !!                     it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is
115            !!                     nitrst - 2*nn_dttrc
116            !!                     -- nevertheless we didn't wanted to broke something already working
117            !!                     and just adapted the part we added.
118            !!                     -- So instead of calling ju2ymds( fjulday + (rdttra(1))
119            !!                     we call ju2ymds( fjulday + (2*rdttra(1))
120            !!--------------------------------------------------------------------     
121            zfjulday = fjulday + (2*rdttra(1)) / rday
122            IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
123            CALL ju2ymds( zfjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec )
124            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
125         ELSE
126            ! beware of the format used to write kt (default is i8.8, that should be large enough)
127            IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
128            ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
129            ENDIF
130         ENDIF
131         ! create the file
132         IF(lwp) WRITE(numout,*)
133         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
134         clpath = TRIM(cn_trcrst_outdir)
135         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
136         IF(lwp) WRITE(numout,*) &
137             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname
138         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
139         lrst_trc = .TRUE.
140      ENDIF
141      !
142   END SUBROUTINE trc_rst_opn
143
144   SUBROUTINE trc_rst_read
145      !!----------------------------------------------------------------------
146      !!                    ***  trc_rst_opn  ***
147      !!
148      !! ** purpose  :   read passive tracer fields in restart files
149      !!----------------------------------------------------------------------
150      INTEGER  ::  jn, jl     
151      !! AXY (05/11/13): temporary variables
152      REAL(wp) ::    fq0,fq1,fq2
153
154      !!----------------------------------------------------------------------
155      !
156      IF(lwp) WRITE(numout,*)
157      IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
158      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
159
160      ! READ prognostic variables and computes diagnostic variable
161      DO jn = 1, jptra
162         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
163         trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:)
164      END DO
165
166      DO jn = 1, jptra
167         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
168         trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:)
169      END DO
170      !
171      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
172      !!                 call to MEDUSA-2 at this point; this suggests that the FCM
173      !!                 version of NEMO date significantly earlier than the current
174      !!                 version
175
176#if defined key_medusa
177      !! AXY (13/01/12): check if the restart contains sediment fields;
178      !!                 this is only relevant for simulations that include
179      !!                 biogeochemistry and are restarted from earlier runs
180      !!                 in which there was no sediment component
181      !!
182      IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN
183         !! YES; in which case read them
184         !!
185         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...'
186         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N',  zb_sed_n(:,:)  )
187         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N',  zn_sed_n(:,:)  )
188         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) )
189         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) )
190         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) )
191         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) )
192         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C',  zb_sed_c(:,:)  )
193         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C',  zn_sed_c(:,:)  )
194         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) )
195         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) )
196      ELSE
197         !! NO; in which case set them to zero
198         !!
199         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...'
200         zb_sed_n(:,:)  = 0.0   !! organic N
201         zn_sed_n(:,:)  = 0.0
202         zb_sed_fe(:,:) = 0.0   !! organic Fe
203         zn_sed_fe(:,:) = 0.0
204         zb_sed_si(:,:) = 0.0   !! inorganic Si
205         zn_sed_si(:,:) = 0.0
206         zb_sed_c(:,:)  = 0.0   !! organic C
207         zn_sed_c(:,:)  = 0.0
208         zb_sed_ca(:,:) = 0.0   !! inorganic C
209         zn_sed_ca(:,:) = 0.0
210      ENDIF
211      !!
212      !! calculate stats on these fields
213      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
214      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N')
215      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe')
216      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si')
217      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C')
218      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca')
219      !!
220      !! AXY (07/07/15): read in temporally averaged fields for DMS
221      !!                 calculations
222      !!
223      IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN
224         !! YES; in which case read them
225         !!
226         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...'
227         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
228         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
229         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
230         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
231         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
232         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
233         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
234         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
235         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN',  zb_dms_din(:,:)  )
236         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN',  zn_dms_din(:,:)  )
237      ELSE
238         !! NO; in which case set them to zero
239         !!
240         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...'
241         zb_dms_chn(:,:)  = 0.0   !! CHN
242         zn_dms_chn(:,:)  = 0.0
243         zb_dms_chd(:,:)  = 0.0   !! CHD
244         zn_dms_chd(:,:)  = 0.0
245         zb_dms_mld(:,:)  = 0.0   !! MLD
246         zn_dms_mld(:,:)  = 0.0
247         zb_dms_qsr(:,:)  = 0.0   !! QSR
248         zn_dms_qsr(:,:)  = 0.0
249         zb_dms_din(:,:)  = 0.0   !! DIN
250         zn_dms_din(:,:)  = 0.0
251      ENDIF
252      !! 
253      !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart
254      !!                  -- needed for the coupling with atm
255      IF( iom_varid( numrtr, 'N_DMS_srf', ldstop = .FALSE. ) > 0 ) THEN
256         IF(lwp) WRITE(numout,*) 'DMS surf concentration - reading in ...'
257         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_srf',  zb_dms_srf(:,:)  )
258         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_srf',  zn_dms_srf(:,:)  )
259      ELSE
260         IF(lwp) WRITE(numout,*) 'DMS surf concentration - setting to zero ...'
261         zb_dms_srf(:,:)  = 0.0   !! DMS
262         zn_dms_srf(:,:)  = 0.0
263      ENDIF
264      IF (lk_oasis) THEN
265         DMS_out_cpl(:,:) = zn_dms_srf(:,:)        !! Coupling variable
266      END IF
267      !!
268      IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN
269         IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - reading in ...'
270         CALL iom_get( numrtr, jpdom_autoglo, 'B_CO2_flx',  zb_co2_flx(:,:)  )
271         CALL iom_get( numrtr, jpdom_autoglo, 'N_CO2_flx',  zn_co2_flx(:,:)  )
272      ELSE
273         IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - setting to zero ...'
274         zb_co2_flx(:,:)  = 0.0   !! CO2 flx
275         zn_co2_flx(:,:)  = 0.0
276      ENDIF
277      IF (lk_oasis) THEN
278         CO2Flux_out_cpl(:,:) =  zn_co2_flx(:,:)   !! Coupling variable
279      END IF
280      !!
281      !! JPALM 02-06-2017 -- in complement to DMS surf
282      !!                  -- the atm model needs surf Chl
283      !!                     as proxy of org matter from the ocean
284      !!                  -- needed for the coupling with atm
285      !!       07-12-2017 -- To make things cleaner, we want to store an 
286      !!                     unscaled Chl field in the restart and only
287      !!                     scale it when reading it in.
288
289      IF( iom_varid( numrtr, 'N_CHL_srf', ldstop = .FALSE. ) > 0 ) THEN
290         IF(lwp) WRITE(numout,*) 'Chl cpl concentration - reading in ... - scale by ', scl_chl
291         CALL iom_get( numrtr, jpdom_autoglo, 'N_CHL_srf',  zn_chl_srf(:,:)  )
292      ELSE
293         IF(lwp) WRITE(numout,*) 'set Chl coupled concentration - scaled by ', scl_chl
294         zn_chl_srf(:,:)  = MAX( 0.0, (trn(:,:,1,jpchn) + trn(:,:,1,jpchd)) * 1.E-6 )
295      ENDIF
296      IF (lk_oasis) THEN
297         chloro_out_cpl(:,:) = zn_chl_srf(:,:) * scl_chl        !! Coupling variable
298      END IF
299      !!
300      !! calculate stats on these fields
301      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
302      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN')
303      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD')
304      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD')
305      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR')
306      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN')
307      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf')
308      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux')
309      IF (lk_oasis) THEN
310         call trc_rst_dia_stat(chloro_out_cpl(:,:), 'CHL  cpl')
311      END IF
312      !! 
313      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart
314      !!                  -- needed for monthly call of carb-chem routine and better reproducibility
315# if defined key_roam
316      IF( iom_varid( numrtr, 'pH_3D', ldstop = .FALSE. ) > 0 ) THEN
317         IF(lwp) WRITE(numout,*) 'Carbonate chem variable - reading in ...'
318         CALL iom_get( numrtr, jpdom_autoglo, 'pH_3D'   ,  f3_pH(:,:,:)     )
319         CALL iom_get( numrtr, jpdom_autoglo, 'h2CO3_3D',  f3_h2co3(:,:,:)  )
320         CALL iom_get( numrtr, jpdom_autoglo, 'hCO3_3D' ,  f3_hco3(:,:,:)   )
321         CALL iom_get( numrtr, jpdom_autoglo, 'CO3_3D'  ,  f3_co3(:,:,:)    )
322         CALL iom_get( numrtr, jpdom_autoglo, 'omcal_3D',  f3_omcal(:,:,:)  )
323         CALL iom_get( numrtr, jpdom_autoglo, 'omarg_3D',  f3_omarg(:,:,:)  )
324         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_CAL' ,  f2_ccd_cal(:,:)  )
325         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_ARG' ,  f2_ccd_arg(:,:)  )
326         !!
327         IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...'
328      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf')
329      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf')
330      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' )
331      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' )
332      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf')
333      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf')
334      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL')
335      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG')
336
337      ELSE
338         IF(lwp) WRITE(numout,*) 'WARNING : No Carbonate-chem variable in the restart.... '
339         IF(lwp) WRITE(numout,*) 'Is not a problem if start a month, but may be very problematic if not '
340         IF(lwp) WRITE(numout,*) 'Check if   mod(kt*rdt,2592000) == rdt' 
341         IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...' 
342      ENDIF
343      !
344#  if defined key_foam_medusa
345      !! 2D fields of pCO2 and fCO2 for observation operator on first timestep
346      IF( iom_varid( numrtr, 'PCO2W', ldstop = .FALSE. ) > 0 ) THEN
347         IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 present - reading in ...'
348         CALL iom_get( numrtr, jpdom_autoglo, 'PCO2W',  f2_pco2w(:,:)  )
349         CALL iom_get( numrtr, jpdom_autoglo, 'FCO2W',  f2_fco2w(:,:)  )
350      ELSE
351         IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 absent - setting to fill ...'
352         f2_pco2w(:,:) = obfillflt * tmask(:,:,1)
353         f2_fco2w(:,:) = obfillflt * tmask(:,:,1)
354      ENDIF
355#  endif
356# endif
357# if defined key_foam_medusa
358      !! Fields for ocean colour assimilation on first timestep
359      IF( iom_varid( numrtr, 'pgrow_avg', ldstop = .FALSE. ) > 0 ) THEN
360         IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...'
361         CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg',  pgrow_avg(:,:)  )
362         CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg',  ploss_avg(:,:)  )
363         CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg',   phyt_avg(:,:)   )
364         CALL iom_get( numrtr, jpdom_autoglo, 'mld_max',    mld_max(:,:)    )
365      ELSE
366         IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg absent - setting to zero ...'
367         pgrow_avg(:,:) = 0.0
368         ploss_avg(:,:) = 0.0
369         phyt_avg(:,:)  = 0.0
370         mld_max(:,:)   = 0.0
371      ENDIF
372      IF( iom_varid( numrtr, 'pgrow_avg_3d', ldstop = .FALSE. ) > 0 ) THEN
373         IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...'
374         CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg_3d',  pgrow_avg_3d(:,:,:)  )
375         CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg_3d',  ploss_avg_3d(:,:,:)  )
376         CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg_3d',   phyt_avg_3d(:,:,:)   )
377      ELSE
378         IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg_3d absent - setting to zero ...'
379         pgrow_avg_3d(:,:,:) = 0.0
380         ploss_avg_3d(:,:,:) = 0.0
381         phyt_avg_3d(:,:,:)  = 0.0
382      ENDIF
383# endif
384
385#endif
386      !
387#if defined key_idtra
388      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and
389      !!                        writting here undre their key.
390      !!                        problems in CFC restart, maybe because of this...
391      !!                        and pb in idtra diag or diad-restart writing.
392      !!----------------------------------------------------------------------
393      IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN
394         !! YES; in which case read them
395         !!
396         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...'
397         CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA',  qint_idtra(:,:,1)  )
398      ELSE
399         !! NO; in which case set them to zero
400         !!
401         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...'
402         qint_idtra(:,:,1)  = 0.0   !! CHN
403      ENDIF
404      !!
405      !! calculate stats on these fields
406      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...'
407      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA')
408#endif
409      !
410#if defined key_cfc
411      DO jl = 1, jp_cfc
412         jn = jp_cfc0 + jl - 1
413         IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN
414            !! YES; in which case read them
415            !!
416            IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...'
417            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
418         ELSE
419            !! NO; in which case set them to zero
420            !!
421            IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...'
422            qint_cfc(:,:,jn)  = 0.0   !! CHN
423         ENDIF
424         !!
425         !! calculate stats on these fields
426         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...'
427         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn))
428      END DO
429#endif
430      !
431   END SUBROUTINE trc_rst_read
432
433   SUBROUTINE trc_rst_wri( kt )
434      !!----------------------------------------------------------------------
435      !!                    ***  trc_rst_wri  ***
436      !!
437      !! ** purpose  :   write passive tracer fields in restart files
438      !!----------------------------------------------------------------------
439      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
440      !!
441      INTEGER  :: jn, jl
442      REAL(wp) :: zarak0
443      !! AXY (05/11/13): temporary variables
444      REAL(wp) ::    fq0,fq1,fq2
445      !!----------------------------------------------------------------------
446      !
447      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step
448      ! prognostic variables
449      ! --------------------
450      DO jn = 1, jptra
451         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
452      END DO
453
454      DO jn = 1, jptra
455         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
456      END DO
457
458      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
459      !!                 call to MEDUSA-2 at this point; this suggests that the FCM
460      !!                 version of NEMO date significantly earlier than the current
461      !!                 version
462
463#if defined key_medusa
464      !! AXY (13/01/12): write out "before" and "now" state of seafloor
465      !!                 sediment pools into restart; this happens
466      !!                 whether or not the pools are to be used by
467      !!                 MEDUSA (which is controlled by a switch in the
468      !!                 namelist_top file)
469      !!
470      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...'
471      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N',  zb_sed_n(:,:)  )
472      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N',  zn_sed_n(:,:)  )
473      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) )
474      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) )
475      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) )
476      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) )
477      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C',  zb_sed_c(:,:)  )
478      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C',  zn_sed_c(:,:)  )
479      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) )
480      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) )
481      !!
482      !! calculate stats on these fields
483      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
484      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N')
485      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe')
486      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si')
487      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C')
488      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca')
489      !!
490      !! AXY (07/07/15): write out temporally averaged fields for DMS
491      !!                 calculations
492      !!
493      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...'
494      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
495      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
496      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
497      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
498      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
499      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
500      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
501      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
502      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN',  zb_dms_din(:,:)  )
503      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN',  zn_dms_din(:,:)  )
504         !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart
505         !!                  -- needed for the coupling with atm
506      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf',  zb_dms_srf(:,:)  )
507      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf',  zn_dms_srf(:,:)  )
508      CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx',  zb_co2_flx(:,:)  )
509      CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx',  zn_co2_flx(:,:)  )
510      !! JPALM 07-12-2017 -- To make things cleaner, we want to store an 
511      !!                     unscaled Chl field in the restart and only
512      !!                     scale it when reading it in.
513      CALL iom_rstput( kt, nitrst, numrtw, 'N_CHL_srf',  zn_chl_srf(:,:)  )
514      !!
515      !! calculate stats on these fields
516      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
517      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN')
518      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD')
519      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD')
520      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR')
521      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN')
522      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf')
523      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux')
524      call trc_rst_dia_stat(zn_chl_srf(:,:), 'unscaled CHL cpl')
525      !!
526      IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.'
527      call trc_rst_dia_stat(dust(:,:), 'Dust dep')
528      call trc_rst_dia_stat(zirondep(:,:), 'Iron dep')
529      !!
530      !! 
531      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart
532      !!                  -- needed for monthly call of carb-chem routine and better reproducibility
533# if defined key_roam
534      IF(lwp) WRITE(numout,*) 'Carbonate chem variable - writing out ...'
535      CALL iom_rstput( kt, nitrst, numrtw, 'pH_3D'   ,  f3_pH(:,:,:)     )
536      CALL iom_rstput( kt, nitrst, numrtw, 'h2CO3_3D',  f3_h2co3(:,:,:)  )
537      CALL iom_rstput( kt, nitrst, numrtw, 'hCO3_3D' ,  f3_hco3(:,:,:)   )
538      CALL iom_rstput( kt, nitrst, numrtw, 'CO3_3D'  ,  f3_co3(:,:,:)    )
539      CALL iom_rstput( kt, nitrst, numrtw, 'omcal_3D',  f3_omcal(:,:,:)  )
540      CALL iom_rstput( kt, nitrst, numrtw, 'omarg_3D',  f3_omarg(:,:,:)  )
541      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_CAL' ,  f2_ccd_cal(:,:)  )
542      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_ARG' ,  f2_ccd_arg(:,:)  )
543      !!
544      IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...'
545      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf')
546      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf')
547      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' )
548      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' )
549      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf')
550      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf')
551      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL')
552      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG')
553      !!
554#  if defined key_foam_medusa
555      !! Fields for observation operator on first timestep
556      IF(lwp) WRITE(numout,*) ' MEDUSA OBS fields - writing out ...'
557      CALL iom_rstput( kt, nitrst, numrtw, 'PCO2W', f2_pco2w(:,:)  )
558      CALL iom_rstput( kt, nitrst, numrtw, 'FCO2W', f2_fco2w(:,:)  )
559#  endif
560# endif
561# if defined key_foam_medusa
562      !! Fields for assimilation on first timestep
563      IF(lwp) WRITE(numout,*) ' MEDUSA ASM fields - writing out ...'
564      CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg', pgrow_avg(:,:) )
565      CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg', ploss_avg(:,:) )
566      CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg',  phyt_avg(:,:)  )
567      CALL iom_rstput( kt, nitrst, numrtw, 'mld_max',   mld_max(:,:)   )
568      CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg_3d', pgrow_avg_3d(:,:,:) )
569      CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg_3d', ploss_avg_3d(:,:,:) )
570      CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg_3d',  phyt_avg_3d(:,:,:)  )
571# endif
572!!
573#endif
574      !
575#if defined key_idtra
576      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and
577      !!                        writting here undre their key.
578      !!                        problems in CFC restart, maybe because of this...
579      !!                        and pb in idtra diag or diad-restart writing.
580      !!----------------------------------------------------------------------
581      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...'
582      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA',  qint_idtra(:,:,1) )
583      !!
584      !! calculate stats on these fields
585      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...'
586      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA')
587#endif
588      !
589#if defined key_cfc
590      DO jl = 1, jp_cfc
591         jn = jp_cfc0 + jl - 1
592         IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...'
593         CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
594         !!
595         !! calculate stats on these fields
596         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...'
597         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn))
598      END DO
599#endif
600      !
601
602      IF( kt == nitrst ) THEN
603          CALL trc_rst_stat            ! statistics
604#if defined key_medusa && defined key_roam
605          CALL trc_rst_conserve        ! conservation check
606#endif
607          CALL iom_close( numrtw )     ! close the restart file (only at last time step)
608#if ! defined key_trdmxl_trc
609          lrst_trc = .FALSE.
610#endif
611          IF( lk_offline .AND. ln_rst_list ) THEN
612             nrst_lst = nrst_lst + 1
613             nitrst = nstocklist( nrst_lst )
614          ENDIF
615      ENDIF
616      !
617   END SUBROUTINE trc_rst_wri 
618
619
620   SUBROUTINE trc_rst_cal( kt, cdrw )
621      !!---------------------------------------------------------------------
622      !!                   ***  ROUTINE trc_rst_cal  ***
623      !!
624      !!  ** Purpose : Read or write calendar in restart file:
625      !!
626      !!  WRITE(READ) mode:
627      !!       kt        : number of time step since the begining of the experiment at the
628      !!                   end of the current(previous) run
629      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
630      !!                   end of the current(previous) run (REAL -> keep fractions of day)
631      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
632      !!
633      !!   According to namelist parameter nrstdt,
634      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
635      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
636      !!                   time step of previous run + 1.
637      !!       In both those options, the  exact duration of the experiment
638      !!       since the beginning (cumulated duration of all previous restart runs)
639      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt.
640      !!       This is valid is the time step has remained constant.
641      !!
642      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
643      !!                    has been stored in the restart file.
644      !!----------------------------------------------------------------------
645      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
646      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
647      !
648      INTEGER  ::  jlibalt = jprstlib
649      LOGICAL  ::  llok
650      REAL(wp) ::  zkt, zrdttrc1
651      REAL(wp) ::  zndastp
652
653      ! Time domain : restart
654      ! ---------------------
655
656      IF( TRIM(cdrw) == 'READ' ) THEN
657
658         IF(lwp) WRITE(numout,*)
659         IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
660         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
661
662         IF ( jprstlib == jprstdimg ) THEN
663           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
664           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
665           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
666           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
667         ENDIF
668
669         IF( ln_rsttr ) THEN
670            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
671            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
672
673            IF(lwp) THEN
674               WRITE(numout,*) ' *** Info read in restart : '
675               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
676               WRITE(numout,*) ' *** restart option'
677               SELECT CASE ( nn_rsttr )
678               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
679               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
680               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
681               END SELECT
682               WRITE(numout,*)
683            ENDIF
684            ! Control of date
685            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
686               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
687               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
688         ENDIF
689         !
690         IF( lk_offline ) THEN   
691            !                                          ! set the date in offline mode
692            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
693               CALL iom_get( numrtr, 'ndastp', zndastp ) 
694               ndastp = NINT( zndastp )
695               CALL iom_get( numrtr, 'adatrj', adatrj  )
696             ELSE
697               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
698               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
699               ! note this is wrong if time step has changed during run
700            ENDIF
701            !
702            IF(lwp) THEN
703              WRITE(numout,*) ' *** Info used values : '
704              WRITE(numout,*) '   date ndastp                                      : ', ndastp
705              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
706              WRITE(numout,*)
707            ENDIF
708            !
709            IF( ln_rsttr )  THEN   ;    neuler = 1
710            ELSE                   ;    neuler = 0
711            ENDIF
712            !
713            CALL day_init          ! compute calendar
714            !
715         ENDIF
716         !
717      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
718         !
719         IF(  kt == nitrst ) THEN
720            IF(lwp) WRITE(numout,*)
721            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
722            IF(lwp) WRITE(numout,*) '~~~~~~~'
723         ENDIF
724         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
725         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
726         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
727         !                                                                     ! the begining of the run [s]
728      ENDIF
729
730   END SUBROUTINE trc_rst_cal
731
732
733   SUBROUTINE trc_rst_stat
734      !!----------------------------------------------------------------------
735      !!                    ***  trc_rst_stat  ***
736      !!
737      !! ** purpose  :   Compute tracers statistics
738      !!----------------------------------------------------------------------
739      INTEGER  :: jk, jn
740      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
741      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
742      !!----------------------------------------------------------------------
743
744      IF( lwp ) THEN
745         WRITE(numout,*) 
746         WRITE(numout,*) '           ----TRACER STAT----             '
747         WRITE(numout,*) 
748      ENDIF
749      !
750      DO jk = 1, jpk
751         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
752      END DO
753      !
754      DO jn = 1, jptra
755         ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
756         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
757         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
758         IF( lk_mpp ) THEN
759            CALL mpp_min( zmin )      ! min over the global domain
760            CALL mpp_max( zmax )      ! max over the global domain
761         END IF
762         zmean  = ztraf / areatot
763         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp
764         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
765      END DO
766      IF(lwp) WRITE(numout,*) 
7679000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
768      &      '    max :',e18.10,'    drift :',e18.10, ' %')
769      !
770   END SUBROUTINE trc_rst_stat
771
772
773# if defined key_medusa && defined key_roam
774   SUBROUTINE trc_rst_conserve
775      !!----------------------------------------------------------------------
776      !!                    ***  trc_rst_conserve  ***
777      !!
778      !! ** purpose  :   Compute tracers conservation statistics
779      !!
780      !! AXY (17/11/2017)
781      !! This routine calculates the "now" inventories of the elemental
782      !! cycles of MEDUSA and compares them to those calculate when the
783      !! model was initialised / restarted; the cycles calculated are:
784      !!    nitrogen, silicon, iron, carbon, alkalinity and oxygen
785      !!----------------------------------------------------------------------
786      INTEGER  :: ji, jj, jk, jn
787      REAL(wp) :: zsum3d, zsum2d, zinvt, zdelta, zratio, loc_vol, loc_are
788      REAL(wp) :: zq1, zq2, loc_vol, loc_area
789      REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d, zvol
790      REAL(wp), DIMENSION(jpi,jpj)     :: z2d, zarea
791      REAL(wp), DIMENSION(6)           :: loc_cycletot3, loc_cycletot2
792      !!----------------------------------------------------------------------
793      !
794      IF( lwp ) THEN
795         WRITE(numout,*) 
796         WRITE(numout,*) '           ----TRACER CONSERVATION----             '
797         WRITE(numout,*) 
798      ENDIF
799      !
800      ! ocean volume
801      DO jk = 1, jpk
802         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
803      END DO
804      !
805      ! ocean area (for sediments)
806      zarea(:,:)      = e1e2t(:,:) * tmask(:,:,1)
807      !
808      !----------------------------------------------------------------------
809      ! nitrogen
810      z3d(:,:,:) = trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + &
811                   trn(:,:,:,jpzme) + trn(:,:,:,jpdet) + trn(:,:,:,jpdin)
812      z2d(:,:)   = zn_sed_n(:,:)
813      zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
814      zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) )
815      ! total tracer, and delta
816      zinvt      = zsum3d + zsum2d
817      zdelta     = zinvt - cycletot(1)
818      zratio     = 1.0e2 * zdelta / cycletot(1)
819      !
820      IF ( lwp ) WRITE(numout,9010) 'nitrogen', zsum3d, zsum2d, zinvt,   &
821         cycletot(1), zdelta, zratio
822      IF ( lwp ) WRITE(numout,*) 
823      !
824      !----------------------------------------------------------------------
825      ! silicon
826      z3d(:,:,:) = trn(:,:,:,jppds) + trn(:,:,:,jpsil)
827      z2d(:,:)   = zn_sed_si(:,:)
828      zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
829      zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) )
830      ! total tracer, and delta
831      zinvt      = zsum3d + zsum2d
832      zdelta     = zinvt - cycletot(2)
833      zratio     = 1.0e2 * zdelta / cycletot(2)
834      !
835      IF ( lwp ) WRITE(numout,9010) 'silicon', zsum3d, zsum2d, zinvt,    &
836         cycletot(2), zdelta, zratio
837      IF ( lwp ) WRITE(numout,*) 
838      !
839      !----------------------------------------------------------------------
840      ! iron
841      z3d(:,:,:) = ((trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + &
842            trn(:,:,:,jpzme) + trn(:,:,:,jpdet)) * xrfn) + trn(:,:,:,jpfer)
843      z2d(:,:)   = zn_sed_fe(:,:)
844      zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
845      zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) )
846      ! total tracer, and delta
847      zinvt      = zsum3d + zsum2d
848      zdelta     = zinvt - cycletot(3)
849      zratio     = 1.0e2 * zdelta / cycletot(3)
850      !
851      IF ( lwp ) WRITE(numout,9010) 'iron', zsum3d, zsum2d, zinvt,       &
852         cycletot(3), zdelta, zratio
853      IF ( lwp ) WRITE(numout,*) 
854      !
855      !----------------------------------------------------------------------
856      ! carbon
857      z3d(:,:,:) = (trn(:,:,:,jpphn) * xthetapn)  + (trn(:,:,:,jpphd) * xthetapd)  + &
858                   (trn(:,:,:,jpzmi) * xthetazmi) + (trn(:,:,:,jpzme) * xthetazme) + &
859                   trn(:,:,:,jpdtc) + trn(:,:,:,jpdic)
860      z2d(:,:)   = zn_sed_c(:,:) + zn_sed_ca(:,:)
861      zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
862      zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) )
863      ! total tracer, and delta
864      zinvt      = zsum3d + zsum2d
865      zdelta     = zinvt - cycletot(4)
866      zratio     = 1.0e2 * zdelta / cycletot(4)
867      !
868      IF ( lwp ) WRITE(numout,9010) 'carbon', zsum3d, zsum2d, zinvt,     &
869         cycletot(4), zdelta, zratio
870      IF ( lwp ) WRITE(numout,*) 
871      !
872      !----------------------------------------------------------------------
873      ! alkalinity
874      z3d(:,:,:) = trn(:,:,:,jpalk)
875      z2d(:,:)   = zn_sed_ca(:,:) * 2.0
876      zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
877      zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) )
878      ! total tracer, and delta
879      zinvt      = zsum3d + zsum2d
880      zdelta     = zinvt - cycletot(5)
881      zratio     = 1.0e2 * zdelta / cycletot(5)
882      !
883      IF ( lwp ) WRITE(numout,9010) 'alkalinity', zsum3d, zsum2d, zinvt, &
884         cycletot(5), zdelta, zratio
885      IF ( lwp ) WRITE(numout,*) 
886      !
887      !----------------------------------------------------------------------
888      ! oxygen
889      z3d(:,:,:) = trn(:,:,:,jpoxy)
890      z2d(:,:)   = 0.0
891      zsum3d     = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
892      zsum2d     = glob_sum( z2d(:,:) * zarea(:,:) )
893      ! total tracer, and delta
894      zinvt      = zsum3d + zsum2d
895      zdelta     = zinvt - cycletot(6)
896      zratio     = 1.0e2 * zdelta / cycletot(6)
897      !
898      IF ( lwp ) WRITE(numout,9010) 'oxygen', zsum3d, zsum2d, zinvt,     &
899         cycletot(6), zdelta, zratio
900      !
901      !----------------------------------------------------------------------
902      ! Check
903      zsum3d        = glob_sum( zvol(:,:,:) )
904      zsum2d        = glob_sum( zarea(:,:) )
905      IF ( lwp ) THEN
906         WRITE(numout,*)
907         WRITE(numout,*) ' check : cvol    : ', zsum3d
908         WRITE(numout,*) ' check : carea   : ', zsum2d
909         WRITE(numout,*)
910      ENDIF
911      !
9129010  FORMAT(' element:',a10,                     &
913             ' 3d sum:',e18.10,' 2d sum:',e18.10, &
914             ' total:',e18.10,' initial:',e18.10, &
915             ' delta:',e18.10,' %:',e18.10)
916      !
917   END SUBROUTINE trc_rst_conserve 
918# endif
919
920
921#else
922   !!----------------------------------------------------------------------
923   !!  Dummy module :                                     No passive tracer
924   !!----------------------------------------------------------------------
925CONTAINS
926   SUBROUTINE trc_rst_read                      ! Empty routines
927   END SUBROUTINE trc_rst_read
928   SUBROUTINE trc_rst_wri( kt )
929      INTEGER, INTENT ( in ) :: kt
930      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
931   END SUBROUTINE trc_rst_wri   
932#endif
933
934   !!----------------------------------------------------------------------
935   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
936   !! $Id$
937   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
938   !!======================================================================
939END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.