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_medusa.F90 in branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcrst_medusa.F90 @ 8201

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

JPALM --30-10-2015-- Add MOCSY and DMS to MEDUSA-NEMO3.6

File size: 14.2 KB
Line 
1MODULE trcrst_medusa
2   !!======================================================================
3   !!                       ***  MODULE trcrst_medusa  ***
4   !! TOP :   create, write, read the restart files of MEDUSA tracer
5   !!======================================================================
6   !! History :   1.0  !  2010-01 (C. Ethe) Original
7   !!             1.1  !  2014-07 (A. Yool; J. Palmieri) converted for MEDUSA
8   !!             1.2  !  2015-07 (A. Yool) add averaged fields for DMS
9   !!----------------------------------------------------------------------
10#if defined key_medusa
11   !!----------------------------------------------------------------------
12   !!   'key_medusa'                                               medusa tracers
13   !!----------------------------------------------------------------------
14   !!   trc_rst_read_medusa   : read  restart file
15   !!   trc_rst_wri_medusa    : write restart file
16   !!----------------------------------------------------------------------
17   USE oce_trc         ! Ocean variables
18   USE par_trc         ! TOP parameters
19   USE trc             ! TOP variables
20   USE trcsms_medusa   ! MEDUSA sms trends
21   USE sms_medusa      ! MEDUSA sms trends
22   USE iom
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC  trc_rst_read_medusa  ! called by trcini.F90 module (actually trcrst.F90)
28   PUBLIC  trc_rst_wri_medusa   ! called by trcini.F90 module (actually trcrst.F90)
29
30CONTAINS
31   
32   SUBROUTINE trc_rst_read_medusa( knum ) 
33      !!----------------------------------------------------------------------
34      !!                     ***  trc_rst_read_medusa  *** 
35      !!
36      !! ** Purpose : Read in restart file specific variables from medusa model
37      !!
38      !!----------------------------------------------------------------------
39      INTEGER, INTENT(in)  :: knum  ! unit of the restart file
40      !! AXY (07/07/14): temporary variables
41      REAL(wp) ::    fq0,fq1,fq2
42      !!----------------------------------------------------------------------
43
44      IF(lwp) WRITE(numout,*)
45      IF(lwp) WRITE(numout,*) ' trc_rst_read_medusa : Read specific variables from medusa model '
46      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
47
48      !! AXY (07/07/14): remove LOBSTER calls
49      !! CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) )
50      !! CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) )
51
52      !! AXY (07/07/14): as well as passive tracers, the restart files
53      !!                 contain 2D fields of sediments; these need to
54      !!                 be read in specially; hence this routine
55      !!
56      !! AXY (13/01/12): check if the restart contains sediment fields;
57      !!                 this is only relevant for simulations that include
58      !!                 biogeochemistry and are restarted from earlier runs
59      !!                 in which there was no sediment component
60      !!
61      IF( iom_varid( knum, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN
62         !! YES; in which case read them
63         !!
64         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...'
65         CALL iom_get( knum, jpdom_autoglo, 'B_SED_N',  zb_sed_n(:,:)  )
66         CALL iom_get( knum, jpdom_autoglo, 'N_SED_N',  zn_sed_n(:,:)  )
67         CALL iom_get( knum, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) )
68         CALL iom_get( knum, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) )
69         CALL iom_get( knum, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) )
70         CALL iom_get( knum, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) )
71         CALL iom_get( knum, jpdom_autoglo, 'B_SED_C',  zb_sed_c(:,:)  )
72         CALL iom_get( knum, jpdom_autoglo, 'N_SED_C',  zn_sed_c(:,:)  )
73         CALL iom_get( knum, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) )
74         CALL iom_get( knum, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) )
75      ELSE
76         !! NO; in which case set them to zero
77         !!
78         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...'
79         zb_sed_n(:,:)  = 0.0   !! organic N
80         zn_sed_n(:,:)  = 0.0
81         zb_sed_fe(:,:) = 0.0   !! organic Fe
82         zn_sed_fe(:,:) = 0.0
83         zb_sed_si(:,:) = 0.0   !! inorganic Si
84         zn_sed_si(:,:) = 0.0
85         zb_sed_c(:,:)  = 0.0   !! organic C
86         zn_sed_c(:,:)  = 0.0
87         zb_sed_ca(:,:) = 0.0   !! inorganic C
88         zn_sed_ca(:,:) = 0.0
89      ENDIF
90      !!
91      !! calculate stats on these fields
92      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
93      fq0 = MINVAL(zn_sed_n(:,:))
94      fq1 = MAXVAL(zn_sed_n(:,:))
95      fq2 = SUM(zn_sed_n(:,:))
96      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', &
97         &        fq0, fq1, fq2
98      fq0 = MINVAL(zn_sed_fe(:,:))
99      fq1 = MAXVAL(zn_sed_fe(:,:))
100      fq2 = SUM(zn_sed_fe(:,:))
101      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
102         &        fq0, fq1, fq2
103      fq0 = MINVAL(zn_sed_si(:,:))
104      fq1 = MAXVAL(zn_sed_si(:,:))
105      fq2 = SUM(zn_sed_si(:,:))
106      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
107         &        fq0, fq1, fq2
108      fq0 = MINVAL(zn_sed_c(:,:))
109      fq1 = MAXVAL(zn_sed_c(:,:))
110      fq2 = SUM(zn_sed_c(:,:))
111      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', &
112         &        fq0, fq1, fq2
113      fq0 = MINVAL(zn_sed_ca(:,:))
114      fq1 = MAXVAL(zn_sed_ca(:,:))
115      fq2 = SUM(zn_sed_ca(:,:))
116      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
117         &        fq0, fq1, fq2
118
119      !! AXY (07/07/15): read in temporally averaged fields for DMS
120      !!                 calculations
121      !!
122      IF( iom_varid( knum, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN
123         !! YES; in which case read them
124         !!
125         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...'
126         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
127         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
128         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
129         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
130         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
131         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
132         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
133         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
134         CALL iom_get( knum, jpdom_autoglo, 'B_DMS_DIN',  zb_dms_din(:,:)  )
135         CALL iom_get( knum, jpdom_autoglo, 'N_DMS_DIN',  zn_dms_din(:,:)  )
136      ELSE
137         !! NO; in which case set them to zero
138         !!
139         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...'
140         zb_dms_chn(:,:)  = 0.0   !! CHN
141         zn_dms_chn(:,:)  = 0.0
142         zb_dms_chd(:,:)  = 0.0   !! CHD
143         zn_dms_chd(:,:)  = 0.0
144         zb_dms_mld(:,:)  = 0.0   !! MLD
145         zn_dms_mld(:,:)  = 0.0
146         zb_dms_qsr(:,:)  = 0.0   !! QSR
147         zn_dms_qsr(:,:)  = 0.0
148         zb_dms_din(:,:)  = 0.0   !! DIN
149         zn_dms_din(:,:)  = 0.0
150      ENDIF
151      !!
152      !! calculate stats on these fields
153      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
154      fq0 = MINVAL(zn_dms_chn(:,:))
155      fq1 = MAXVAL(zn_dms_chn(:,:))
156      fq2 = SUM(zn_dms_chn(:,:))
157      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2
158      fq0 = MINVAL(zn_dms_chd(:,:))
159      fq1 = MAXVAL(zn_dms_chd(:,:))
160      fq2 = SUM(zn_dms_chd(:,:))
161      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2
162      fq0 = MINVAL(zn_dms_mld(:,:))
163      fq1 = MAXVAL(zn_dms_mld(:,:))
164      fq2 = SUM(zn_dms_mld(:,:))
165      if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2
166      fq0 = MINVAL(zn_dms_qsr(:,:))
167      fq1 = MAXVAL(zn_dms_qsr(:,:))
168      fq2 = SUM(zn_dms_qsr(:,:))
169      if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2
170      fq0 = MINVAL(zn_dms_din(:,:))
171      fq1 = MAXVAL(zn_dms_din(:,:))
172      fq2 = SUM(zn_dms_din(:,:))
173      if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2
174
175   END SUBROUTINE trc_rst_read_medusa
176
177   SUBROUTINE trc_rst_wri_medusa( kt, kitrst, knum )
178      !!----------------------------------------------------------------------
179      !!                     ***  trc_rst_read_medusa  ***
180      !!
181      !! ** Purpose : Read in restart file specific variables from medusa model
182      !!
183      !!----------------------------------------------------------------------
184      INTEGER, INTENT(in)  :: kt      ! time step
185      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
186      INTEGER, INTENT(in)  :: knum    ! unit of the restart file
187      !! AXY (07/07/14): temporary variables
188      REAL(wp) ::    fq0,fq1,fq2
189      !!----------------------------------------------------------------------
190
191      IF(lwp) WRITE(numout,*)
192      IF(lwp) WRITE(numout,*) ' trc_rst_wri_medusa : Write specific variables from medusa model '
193      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
194
195      !! AXY (07/07/14): remove LOBSTER calls
196      !! CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) )
197      !! CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) )
198
199      !! AXY (07/07/14): as well as passive tracers, the restart files
200      !!                 contain 2D fields of sediments; these need to
201      !!                 be written out specially; hence this routine
202      !!
203      !! AXY (13/01/12): write out "before" and "now" state of seafloor
204      !!                 sediment pools into restart; this happens
205      !!                 whether or not the pools are to be used by
206      !!                 MEDUSA (which is controlled by a switch in the
207      !!                 namelist_top file)
208      !!
209      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...'
210      CALL iom_rstput( kt, kitrst, knum, 'B_SED_N',  zb_sed_n(:,:)  )
211      CALL iom_rstput( kt, kitrst, knum, 'N_SED_N',  zn_sed_n(:,:)  )
212      CALL iom_rstput( kt, kitrst, knum, 'B_SED_FE', zb_sed_fe(:,:) )
213      CALL iom_rstput( kt, kitrst, knum, 'N_SED_FE', zn_sed_fe(:,:) )
214      CALL iom_rstput( kt, kitrst, knum, 'B_SED_SI', zb_sed_si(:,:) )
215      CALL iom_rstput( kt, kitrst, knum, 'N_SED_SI', zn_sed_si(:,:) )
216      CALL iom_rstput( kt, kitrst, knum, 'B_SED_C',  zb_sed_c(:,:)  )
217      CALL iom_rstput( kt, kitrst, knum, 'N_SED_C',  zn_sed_c(:,:)  )
218      CALL iom_rstput( kt, kitrst, knum, 'B_SED_CA', zb_sed_ca(:,:) )
219      CALL iom_rstput( kt, kitrst, knum, 'N_SED_CA', zn_sed_ca(:,:) )
220      !!
221      !! calculate stats on these fields
222      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
223      fq0 = MINVAL(zn_sed_n(:,:))
224      fq1 = MAXVAL(zn_sed_n(:,:))
225      fq2 = SUM(zn_sed_n(:,:))
226      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', &
227         &        fq0, fq1, fq2
228      fq0 = MINVAL(zn_sed_fe(:,:))
229      fq1 = MAXVAL(zn_sed_fe(:,:))
230      fq2 = SUM(zn_sed_fe(:,:))
231      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
232         &        fq0, fq1, fq2
233      fq0 = MINVAL(zn_sed_si(:,:))
234      fq1 = MAXVAL(zn_sed_si(:,:))
235      fq2 = SUM(zn_sed_si(:,:))
236      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
237         &        fq0, fq1, fq2
238      fq0 = MINVAL(zn_sed_c(:,:))
239      fq1 = MAXVAL(zn_sed_c(:,:))
240      fq2 = SUM(zn_sed_c(:,:))
241      if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', &
242         &        fq0, fq1, fq2
243      fq0 = MINVAL(zn_sed_ca(:,:))
244      fq1 = MAXVAL(zn_sed_ca(:,:))
245      fq2 = SUM(zn_sed_ca(:,:))
246      if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
247         &        fq0, fq1, fq2
248
249      !! AXY (07/07/15): write out temporally averaged fields for DMS
250      !!                 calculations
251      !!
252      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...'
253      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_CHN',  zb_dms_chn(:,:)  )
254      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_CHN',  zn_dms_chn(:,:)  )
255      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_CHD',  zb_dms_chd(:,:)  )
256      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_CHD',  zn_dms_chd(:,:)  )
257      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_MLD',  zb_dms_mld(:,:)  )
258      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_MLD',  zn_dms_mld(:,:)  )
259      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_QSR',  zb_dms_qsr(:,:)  )
260      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_QSR',  zn_dms_qsr(:,:)  )
261      CALL iom_rstput( kt, kitrst, knum, 'B_DMS_DIN',  zb_dms_din(:,:)  )
262      CALL iom_rstput( kt, kitrst, knum, 'N_DMS_DIN',  zn_dms_din(:,:)  )
263      !!
264      !! calculate stats on these fields
265      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
266      fq0 = MINVAL(zn_dms_chn(:,:))
267      fq1 = MAXVAL(zn_dms_chn(:,:))
268      fq2 = SUM(zn_dms_chn(:,:))
269      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2
270      fq0 = MINVAL(zn_dms_chd(:,:))
271      fq1 = MAXVAL(zn_dms_chd(:,:))
272      fq2 = SUM(zn_dms_chd(:,:))
273      if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2
274      fq0 = MINVAL(zn_dms_mld(:,:))
275      fq1 = MAXVAL(zn_dms_mld(:,:))
276      fq2 = SUM(zn_dms_mld(:,:))
277      if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2
278      fq0 = MINVAL(zn_dms_qsr(:,:))
279      fq1 = MAXVAL(zn_dms_qsr(:,:))
280      fq2 = SUM(zn_dms_qsr(:,:))
281      if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2
282      fq0 = MINVAL(zn_dms_din(:,:))
283      fq1 = MAXVAL(zn_dms_din(:,:))
284      fq2 = SUM(zn_dms_din(:,:))
285      if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2
286
287   END SUBROUTINE trc_rst_wri_medusa
288
289#else
290   !!----------------------------------------------------------------------
291   !!  Dummy module :                                     No passive tracer
292   !!----------------------------------------------------------------------
293CONTAINS
294   SUBROUTINE trc_rst_read_medusa( knum )
295     INTEGER, INTENT(in)  :: knum
296     WRITE(*,*) 'trc_rst_wri_medusa: You should not have seen this print! error?',knum
297   END SUBROUTINE trc_rst_read_medusa
298
299   SUBROUTINE trc_rst_wri_medusa( kt, kitrst, knum )
300     INTEGER, INTENT(in)  :: kt, kitrst, knum
301     WRITE(*,*) 'trc_rst_wri_medusa: You should not have seen this print! error?', kt, kitrst, knum
302   END SUBROUTINE trc_rst_wri_medusa
303#endif
304
305   !!======================================================================
306END MODULE trcrst_medusa
Note: See TracBrowser for help on using the repository browser.