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/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 8436

Last change on this file since 8436 was 8436, checked in by dford, 7 years ago

Implement initial version of surface chlorophyll assimilation for MEDUSA.

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