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.
trcini_medusa.F90 in branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90 @ 6798

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

secure init coupling variable
File size: 18.7 KB
Line 
1MODULE trcini_medusa
2   !!======================================================================
3   !!                         ***  MODULE trcini_medusa  ***
4   !! TOP :   initialisation of the MEDUSA tracers
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
7   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
8   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
9   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
10   !!              -   !  2011-04  (A. Yool) updated for ROAM project
11   !!----------------------------------------------------------------------
12#if defined key_medusa
13   !!----------------------------------------------------------------------
14   !!   'key_medusa'                                         MEDUSA tracers
15   !!----------------------------------------------------------------------
16   !! trc_ini_medusa   : MEDUSA model initialisation
17   !!----------------------------------------------------------------------
18   USE par_trc         ! TOP parameters
19   USE oce_trc
20   USE trc
21   USE in_out_manager
22   !! AXY (04/11/13): add this in for initialisation stuff
23   USE iom
24   USE par_medusa
25   !! AXY (13/01/12): add this in for sediment variables
26   USE sms_medusa
27   !! AXY (04/11/13): add this in for initialisation stuff
28   USE trcsed_medusa
29   USE sbc_oce, ONLY: lk_oasis
30   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl  !! Coupling variable
31
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   trc_ini_medusa   ! called by trcini.F90 module
37
38   !! AXY (25/02/10)
39   LOGICAL, PUBLIC ::                  &
40      bocalccd = .TRUE.
41   !! JPALM (14/09/15)
42   LOGICAL, PUBLIC ::                  &
43      ln_ccd = .TRUE.
44
45   INTEGER ::                          &
46      numccd
47
48   !! AXY (25/02/10)
49   INTEGER ::                          &
50      numriv
51
52   !!----------------------------------------------------------------------
53   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
54   !! $Id$
55   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
56   !!----------------------------------------------------------------------
57
58CONTAINS
59
60   SUBROUTINE trc_ini_medusa
61      !!----------------------------------------------------------------------
62      !!                     ***  trc_ini_medusa  *** 
63      !!
64      !! ** Purpose :   initialization for MEDUSA model
65      !!
66      !! ** Method  : - Read the namcfc namelist and check the parameter values
67      !!----------------------------------------------------------------------
68      !!----------------------------------------------------------------------
69
70      !! vertical array index
71      INTEGER  ::    jk, ierr
72      !! AXY (19/07/12): added jk2 to set up friver_dep array
73      INTEGER            :: jk2
74      !! AXY (19/07/12): added tfthk to set up friver_dep array
75      REAL(wp)           :: fthk, tfthk
76      !! AXY (04/11/13): add in temporary variables for checks
77      REAL(wp)           :: fq0, fq1, fq2
78
79      IF(lwp) WRITE(numout,*)
80      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialisation of MEDUSA model'
81      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
82      IF(lwp) WRITE(numout,*) ' second Test with Julien'
83# if defined key_debug_medusa
84            CALL flush(numout)
85# endif
86
87                                           ! Allocate MEDUSA arrays
88      ierr =         sms_medusa_alloc()
89# if defined key_debug_medusa
90            IF (lwp) write (numout,*) '------------------------------'
91            IF (lwp) write (numout,*) 'Jpalm - debug'
92            IF (lwp) write (numout,*) 'in trc_ini_medusa, just after array allocate'
93            IF (lwp) write (numout,*) ' '
94            CALL flush(numout)
95# endif
96
97!!
98!! AXY (19/07/12): setup array to control distribution of river nutrients
99      friver_dep(:,:) = 0.
100      DO jk = 1,jpk
101         tfthk = 0.
102         DO jk2 = 1,jriver_dep
103            fthk  = e3t_1d(jk2)
104            if (jk2 .le. jk) then
105               tfthk = tfthk + fthk
106               friver_dep(jk2,jk) = fthk
107            endif
108         ENDDO
109         DO jk2 = 1,jriver_dep
110            friver_dep(jk2,jk) = friver_dep(jk2,jk) / tfthk
111         ENDDO
112      ENDDO
113!!
114!! Have a look at the result of this for a single depth (jriver_dep + 1)
115      IF(lwp) THEN
116          WRITE(numout,*) '=== River nutrient fraction by depth (for a water column of jpk depth)'
117          DO jk = 1,jpk
118             WRITE(numout,*)     &
119             &   ' cell = ', jk, ', friver_dep value = ', friver_dep(jk,jpk)
120          ENDDO
121          IF(lwp) CALL flush(numout)
122       ENDIF
123
124#if defined key_roam
125!! ROAM 3D and 2D carbonate system fields (calculated on first time
126!! step, then monthly)
127      f3_pH(:,:,:)    = 0.
128      f3_h2co3(:,:,:) = 0.
129      f3_hco3(:,:,:)  = 0.
130      f3_co3(:,:,:)   = 0.
131      f3_omcal(:,:,:) = 0.
132      f3_omarg(:,:,:) = 0.
133!!
134      f2_ccd_cal(:,:) = 0.
135      f2_ccd_arg(:,:) = 0.
136      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: carbonate fields initialised to zero'
137#endif
138      IF(lwp) CALL flush(numout)
139
140      !!----------------------------------------------------------------------
141      !! State variable initial conditions (all mmol / m3)
142      !!----------------------------------------------------------------------
143      !!     
144      !! biological and detrital components are initialised to nominal
145      !! values above 100 m depth and zero below; the latter condition
146      !! is applied since non-linear loss processes allow significant
147      !! concentrations of these components to persist at depth
148      !!
149      trn(:,:,:,jpchn) = 0.
150      trn(:,:,:,jpchd) = 0.
151      trn(:,:,:,jpphn) = 0.
152      trn(:,:,:,jpphd) = 0.
153      trn(:,:,:,jppds) = 0.
154      trn(:,:,:,jpzmi) = 0.
155      trn(:,:,:,jpzme) = 0.
156      trn(:,:,:,jpdet) = 0.
157      !!
158      DO jk = 1,13
159         !! non-diatom chlorophyll         (nominal)
160         trn(:,:,jk,jpchn) = 0.01
161         !!
162         !! diatom chlorophyll             (nominal)
163         trn(:,:,jk,jpchd) = 0.01
164         !!
165         !! non-diatom                     (nominal)
166         trn(:,:,jk,jpphn) = 0.01
167         !!
168         !! diatom                         (nominal)
169         trn(:,:,jk,jpphd) = 0.01
170         !!
171         !! diatom silicon                 (nominal)
172         trn(:,:,jk,jppds) = 0.01
173         !!
174         !! microzooplankton               (nominal)
175         trn(:,:,jk,jpzmi) = 0.01
176         !!
177         !! mesozooplankton                (nominal)
178         trn(:,:,jk,jpzme) = 0.01
179         !!
180         !! detrital nitrogen              (nominal)
181         trn(:,:,jk,jpdet) = 0.01
182      ENDDO
183      !!
184      !! dissolved inorganic nitrogen     (nominal average value; typically initialised from climatology)
185      trn(:,:,:,jpdin) = 30.
186      !!
187      !! dissolved silicic acid           (nominal average value; typically initialised from climatology)
188      trn(:,:,:,jpsil) = 90.
189      !!
190      !! dissolved "total" iron           (nominal; typically initialised from model-derived climatology)
191      trn(:,:,:,jpfer) = 1.0e-4           !! = 0.1 umol Fe / m3
192      !!
193      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA-1 fields initialised to defaults'
194# if defined key_roam
195      !!
196      !! detrital carbon                  (nominal)
197      trn(:,:,:,jpdtc) = 0.
198      DO jk = 1,13
199         trn(:,:,jk,jpdtc) = 0.06625
200      ENDDO
201      !!
202      !! dissolved inorganic carbon (DIC) (nominal average value; typically initialised from climatology)
203      trn(:,:,:,jpdic) = 2330.
204      !!
205      !! total alkalinity                 (nominal average value; typically initialised from climatology)
206      trn(:,:,:,jpalk) = 2450.
207      !!
208      !! dissolved oxygen                 (nominal average value; typically initialised from climatology)
209      trn(:,:,:,jpoxy) = 175.
210      !!
211      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA-2 fields initialised to defaults'
212# endif
213      IF(lwp) CALL flush(numout)
214
215      !!----------------------------------------------------------------------
216      !! Sediment pools initial conditions (all mmol / m2)
217      !!----------------------------------------------------------------------
218      !!     
219      !! these pools store biogenic material that has sunk to the seabed,
220      !! and act as a temporary reservoir
221      zb_sed_n(:,:)  = 0.0  !! organic N
222      zn_sed_n(:,:)  = 0.0
223      za_sed_n(:,:)  = 0.0
224      zb_sed_fe(:,:) = 0.0  !! organic Fe
225      zn_sed_fe(:,:) = 0.0
226      za_sed_fe(:,:) = 0.0
227      zb_sed_si(:,:) = 0.0  !! inorganic Si
228      zn_sed_si(:,:) = 0.0
229      za_sed_si(:,:) = 0.0
230      zb_sed_c(:,:)  = 0.0  !! organic C
231      zn_sed_c(:,:)  = 0.0
232      za_sed_c(:,:)  = 0.0
233      zb_sed_ca(:,:) = 0.0  !! inorganic C
234      zn_sed_ca(:,:) = 0.0
235      za_sed_ca(:,:) = 0.0
236      !!
237      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: benthic fields initialised to zero'
238      IF(lwp) CALL flush(numout)
239     
240      !!----------------------------------------------------------------------
241      !! Averaged properties for DMS calculations (various units)
242      !!----------------------------------------------------------------------
243      !!     
244      !! these store temporally averaged properties for DMS calculations (AXY, 07/07/15)
245      zb_dms_chn(:,:)  = 0.0  !! CHN
246      zn_dms_chn(:,:)  = 0.0
247      za_dms_chn(:,:)  = 0.0
248      zb_dms_chd(:,:)  = 0.0  !! CHD
249      zn_dms_chd(:,:)  = 0.0
250      za_dms_chd(:,:)  = 0.0
251      zb_dms_mld(:,:)  = 0.0  !! MLD
252      zn_dms_mld(:,:)  = 0.0
253      za_dms_mld(:,:)  = 0.0
254      zb_dms_qsr(:,:)  = 0.0  !! QSR
255      zn_dms_qsr(:,:)  = 0.0
256      za_dms_qsr(:,:)  = 0.0
257      zb_dms_din(:,:)  = 0.0  !! DIN
258      zn_dms_din(:,:)  = 0.0
259      za_dms_din(:,:)  = 0.0
260      !!
261      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: average fields for DMS initialised to zero'
262      IF(lwp) CALL flush(numout)
263      !!
264      !!---------------------------------------------------------------------
265      !!JPALM (14-06-2016): init dms and co2 flux for coupling with atm (UKESM)
266      !!---------------------------------------------------------------------
267      !!
268      zb_co2_flx(:,:)  = 0.0  !! CHN
269      zn_co2_flx(:,:)  = 0.0
270      za_co2_flx(:,:)  = 0.0
271      zb_dms_srf(:,:)  = 0.0  !! CHD
272      zn_dms_srf(:,:)  = 0.0
273      za_dms_srf(:,:)  = 0.0
274      !!
275      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: DMS and CO2 flux (UKESM) initialised to zero'
276      IF(lwp) CALL flush(numout)
277      IF (lk_oasis) THEN
278         CO2Flux_out_cpl(:,:) =  zn_co2_flx(:,:)   !! Coupling variable
279         DMS_out_cpl(:,:)     =  zn_dms_srf(:,:)   !! Coupling variable
280      END IF
281      !!
282      !!----------------------------------------------------------------------
283      !! AXY (04/11/13): initialise fields previously done by trc_sed_medusa
284      !!----------------------------------------------------------------------
285      !!     
286      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising dust deposition fields'
287      CALL trc_sed_medusa_sbc( nit000 )
288      !!
289      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising ocean CCD array'
290      CALL trc_ini_medusa_ccd( nit000 )
291      fq0 = MINVAL(ocal_ccd(:,:))
292      fq1 = MAXVAL(ocal_ccd(:,:))
293      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
294         & 'CCD: min ', fq0, ' max ', fq1
295      !!
296      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising riverine nutrient arrays'
297      riv_n(:,:)   = 0.0
298      riv_si(:,:)  = 0.0
299      riv_c(:,:)   = 0.0
300      riv_alk(:,:) = 0.0 
301      !!
302      CALL trc_ini_medusa_river( nit000 )
303      fq0 = MINVAL(riv_n(:,:))
304      fq1 = MAXVAL(riv_n(:,:))
305      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
306         & 'RIV_N:   min ', fq0, ' max ', fq1
307      fq0 = MINVAL(riv_si(:,:))
308      fq1 = MAXVAL(riv_si(:,:))
309      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
310         & 'RIV_SI:  min ', fq0, ' max ', fq1
311      fq0 = MINVAL(riv_c(:,:))
312      fq1 = MAXVAL(riv_c(:,:))
313      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
314         & 'RIV_C:   min ', fq0, ' max ', fq1
315      fq0 = MINVAL(riv_alk(:,:))
316      fq1 = MAXVAL(riv_alk(:,:))
317      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
318         & 'RIV_ALK: min ', fq0, ' max ', fq1
319      IF(lwp) CALL flush(numout)
320
321      IF(lwp) WRITE(numout,*)
322      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA initialised'
323      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
324      IF(lwp) CALL flush(numout)
325
326   END SUBROUTINE trc_ini_medusa
327
328   !! ======================================================================
329   !! ======================================================================
330   !! ======================================================================
331
332   !! AXY (25/02/10)
333   SUBROUTINE trc_ini_medusa_ccd(kt)
334
335      !!----------------------------------------------------------------------
336      !!                  ***  ROUTINE trc_ini_medusa_ccd  ***
337      !!
338      !! ** Purpose :   Read CCD field
339      !!
340      !! ** Method  :   Read the file
341      !!
342      !! ** input   :   external netcdf files
343      !!
344      !!----------------------------------------------------------------------
345      !! * arguments
346      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
347
348      !!---------------------------------------------------------------------
349
350      !! Open the file
351      !! -------------
352      !!
353      !!!! JPALM -- 14-09-2015 --
354      !!!!       -- to test on ORCA2 with Christian, no file available, so initiate to 0
355      IF (ln_ccd) THEN
356         IF(lwp) WRITE(numout,*) ' '
357         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd'
358         CALL iom_open ( 'ccd_ocal_nemo.nc', numccd )
359         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc opened'
360
361      !! Read the data
362      !! -------------
363      !!
364         CALL iom_get ( numccd, jpdom_data, 'OCAL_CCD', ocal_ccd )
365         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: data read'
366
367      !! Close the file
368      !! --------------
369      !!
370         CALL iom_close ( numccd )
371         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc closed'
372         IF(lwp) CALL flush(numout)
373      ELSE
374         IF(lwp) WRITE(numout,*) ' '
375         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd'
376         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: do not read ccd_ocal_nemo.nc'
377         IF(lwp) WRITE(numout,*) ' **** ln_ccd = FALSE and ocal_ccd = 0.0 ---'
378         ocal_ccd(:,:) = 0.0 
379      ENDIF
380 
381   END SUBROUTINE trc_ini_medusa_ccd
382
383   !! ======================================================================
384   !! ======================================================================
385   !! ======================================================================
386
387   !! AXY (26/01/12)
388   SUBROUTINE trc_ini_medusa_river(kt)
389
390      !!----------------------------------------------------------------------
391      !!                  ***  ROUTINE trc_ini_medusa_river  ***
392      !!
393      !! ** Purpose :   Read riverine nutrient fields
394      !!
395      !! ** Method  :   Read the file
396      !!
397      !! ** input   :   external netcdf files
398      !!
399      !!----------------------------------------------------------------------
400      !! * arguments
401      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
402
403      !!---------------------------------------------------------------------
404
405      IF(lwp) THEN
406         WRITE(numout,*) ' '
407         WRITE(numout,*) ' **** Routine trc_ini_medusa_river'
408         WRITE(numout,*) ' '
409      ENDIF
410
411      !! Open and read the files
412      !! -----------------------
413      !!
414      if (jriver_n.gt.0) then
415         if (jriver_n.eq.1) CALL iom_open ( 'river_N_conc_orca100.nc', numriv )
416         if (jriver_n.eq.2) CALL iom_open ( 'river_N_flux_orca100.nc', numriv )
417         CALL iom_get  ( numriv, jpdom_data, 'RIV_N', riv_n )
418         IF(lwp) THEN
419            if (jriver_n.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: N CONC data read'
420            if (jriver_n.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: N FLUX data read'
421         ENDIF
422         CALL iom_close ( numriv )
423         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river N file closed'
424      else
425         IF(lwp) THEN
426            WRITE(numout,*) ' **** trc_ini_medusa_river: N data NOT read'
427         ENDIF
428      endif
429      !!
430      if (jriver_si.gt.0) then
431         if (jriver_si.eq.1) CALL iom_open ( 'river_Si_conc_orca100.nc', numriv )
432         if (jriver_si.eq.2) CALL iom_open ( 'river_Si_flux_orca100.nc', numriv )
433         CALL iom_get  ( numriv, jpdom_data, 'RIV_SI', riv_si )
434         IF(lwp) THEN
435            if (jriver_si.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: Si CONC data read'
436            if (jriver_si.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: Si FLUX data read'
437         ENDIF
438         CALL iom_close ( numriv )
439         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river Si file closed'
440      else
441         IF(lwp) THEN
442            WRITE(numout,*) ' **** trc_ini_medusa_river: Si data NOT read'
443         ENDIF
444      endif
445      !!
446      if (jriver_c.gt.0) then
447         if (jriver_c.eq.1) CALL iom_open ( 'river_C_conc_orca100.nc', numriv )
448         if (jriver_c.eq.2) CALL iom_open ( 'river_C_flux_orca100.nc', numriv )
449         CALL iom_get  ( numriv, jpdom_data, 'RIV_C', riv_c )
450         IF(lwp) THEN
451            if (jriver_c.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: C CONC data read'
452            if (jriver_c.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: C FLUX data read'
453         ENDIF
454         CALL iom_close ( numriv )
455         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river C file closed'
456      else
457         IF(lwp) THEN
458            WRITE(numout,*) ' **** trc_ini_medusa_river: C data NOT read'
459         ENDIF
460      endif
461      !!
462      if (jriver_alk.gt.0) then
463         if (jriver_alk.eq.1) CALL iom_open ( 'river_alk_conc_orca100.nc', numriv )
464         if (jriver_alk.eq.2) CALL iom_open ( 'river_alk_flux_orca100.nc', numriv )
465         CALL iom_get  ( numriv, jpdom_data, 'RIV_ALK', riv_alk )
466         IF(lwp) THEN
467            if (jriver_alk.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity CONC data read'
468            if (jriver_alk.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity FLUX data read'
469         ENDIF
470         CALL iom_close ( numriv )
471         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river alkalinity file closed'
472      else
473         IF(lwp) THEN
474            WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity data NOT read'
475         ENDIF
476      endif
477      IF(lwp) CALL flush(numout)
478
479   END SUBROUTINE trc_ini_medusa_river
480   
481#else
482   !!----------------------------------------------------------------------
483   !!   Dummy module                                        No MEDUSA model
484   !!----------------------------------------------------------------------
485CONTAINS
486   SUBROUTINE trc_ini_medusa             ! Empty routine
487   END SUBROUTINE trc_ini_medusa
488#endif
489
490   !!======================================================================
491END MODULE trcini_medusa
Note: See TracBrowser for help on using the repository browser.