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

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

JPALM - merge GO6 branch

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