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 @ 6026

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

JPALM --09-12-2015 -- active dust and ccd again... should move this to namelist...

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