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

Last change on this file since 5739 was 5739, checked in by jpalmier, 9 years ago

JPALM --14-09-2015 -- create a test config without dust and ccd

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