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

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

JPALM --14-09-2015 -- correct mistake in trcini_medusa

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   !! JPALM (14/09/15)
39   LOGICAL, PUBLIC ::                  &
40      ln_ccd = .FALSE.
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      !! AXY (04/11/13): initialise fields previously done by trc_sed_medusa
239      !!----------------------------------------------------------------------
240      !!     
241      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising dust deposition fields'
242      CALL trc_sed_medusa_sbc( nit000 )
243      !!
244      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising ocean CCD array'
245      CALL trc_ini_medusa_ccd( nit000 )
246      fq0 = MINVAL(ocal_ccd(:,:))
247      fq1 = MAXVAL(ocal_ccd(:,:))
248      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
249         & 'CCD: min ', fq0, ' max ', fq1
250      !!
251      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising riverine nutrient arrays'
252      riv_n(:,:)   = 0.0
253      riv_si(:,:)  = 0.0
254      riv_c(:,:)   = 0.0
255      riv_alk(:,:) = 0.0 
256      !!
257      CALL trc_ini_medusa_river( nit000 )
258      fq0 = MINVAL(riv_n(:,:))
259      fq1 = MAXVAL(riv_n(:,:))
260      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
261         & 'RIV_N:   min ', fq0, ' max ', fq1
262      fq0 = MINVAL(riv_si(:,:))
263      fq1 = MAXVAL(riv_si(:,:))
264      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
265         & 'RIV_SI:  min ', fq0, ' max ', fq1
266      fq0 = MINVAL(riv_c(:,:))
267      fq1 = MAXVAL(riv_c(:,:))
268      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
269         & 'RIV_C:   min ', fq0, ' max ', fq1
270      fq0 = MINVAL(riv_alk(:,:))
271      fq1 = MAXVAL(riv_alk(:,:))
272      if (lwp) write (numout,'(a,f10.3,a,f10.3)') & 
273         & 'RIV_ALK: min ', fq0, ' max ', fq1
274      IF(lwp) CALL flush(numout)
275
276      IF(lwp) WRITE(numout,*)
277      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA initialised'
278      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
279      IF(lwp) CALL flush(numout)
280
281   END SUBROUTINE trc_ini_medusa
282
283   !! ======================================================================
284   !! ======================================================================
285   !! ======================================================================
286
287   !! AXY (25/02/10)
288   SUBROUTINE trc_ini_medusa_ccd(kt)
289
290      !!----------------------------------------------------------------------
291      !!                  ***  ROUTINE trc_ini_medusa_ccd  ***
292      !!
293      !! ** Purpose :   Read CCD field
294      !!
295      !! ** Method  :   Read the file
296      !!
297      !! ** input   :   external netcdf files
298      !!
299      !!----------------------------------------------------------------------
300      !! * arguments
301      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
302
303      !!---------------------------------------------------------------------
304
305      !! Open the file
306      !! -------------
307      !!
308      !!!! JPALM -- 14-09-2015 --
309      !!!!       -- to test on ORCA2 with Christian, no file available, so initiate to 0
310      IF (ln_ccd) THEN
311         IF(lwp) WRITE(numout,*) ' '
312         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd'
313         CALL iom_open ( 'ccd_ocal_nemo.nc', numccd )
314         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc opened'
315
316      !! Read the data
317      !! -------------
318      !!
319         CALL iom_get ( numccd, jpdom_data, 'OCAL_CCD', ocal_ccd )
320         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: data read'
321
322      !! Close the file
323      !! --------------
324      !!
325         CALL iom_close ( numccd )
326         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc closed'
327         IF(lwp) CALL flush(numout)
328      ELSE
329         IF(lwp) WRITE(numout,*) ' '
330         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd'
331         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: do not read ccd_ocal_nemo.nc'
332         IF(lwp) WRITE(numout,*) ' **** ln_ccd = FALSE and ocal_ccd = 0.0 ---'
333         ocal_ccd(:,:) = 0.0 
334      ENDIF
335 
336   END SUBROUTINE trc_ini_medusa_ccd
337
338   !! ======================================================================
339   !! ======================================================================
340   !! ======================================================================
341
342   !! AXY (26/01/12)
343   SUBROUTINE trc_ini_medusa_river(kt)
344
345      !!----------------------------------------------------------------------
346      !!                  ***  ROUTINE trc_ini_medusa_river  ***
347      !!
348      !! ** Purpose :   Read riverine nutrient fields
349      !!
350      !! ** Method  :   Read the file
351      !!
352      !! ** input   :   external netcdf files
353      !!
354      !!----------------------------------------------------------------------
355      !! * arguments
356      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
357
358      !!---------------------------------------------------------------------
359
360      IF(lwp) THEN
361         WRITE(numout,*) ' '
362         WRITE(numout,*) ' **** Routine trc_ini_medusa_river'
363         WRITE(numout,*) ' '
364      ENDIF
365
366      !! Open and read the files
367      !! -----------------------
368      !!
369      if (jriver_n.gt.0) then
370         if (jriver_n.eq.1) CALL iom_open ( 'river_N_conc_orca100.nc', numriv )
371         if (jriver_n.eq.2) CALL iom_open ( 'river_N_flux_orca100.nc', numriv )
372         CALL iom_get  ( numriv, jpdom_data, 'RIV_N', riv_n )
373         IF(lwp) THEN
374            if (jriver_n.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: N CONC data read'
375            if (jriver_n.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: N FLUX data read'
376         ENDIF
377         CALL iom_close ( numriv )
378         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river N file closed'
379      else
380         IF(lwp) THEN
381            WRITE(numout,*) ' **** trc_ini_medusa_river: N data NOT read'
382         ENDIF
383      endif
384      !!
385      if (jriver_si.gt.0) then
386         if (jriver_si.eq.1) CALL iom_open ( 'river_Si_conc_orca100.nc', numriv )
387         if (jriver_si.eq.2) CALL iom_open ( 'river_Si_flux_orca100.nc', numriv )
388         CALL iom_get  ( numriv, jpdom_data, 'RIV_SI', riv_si )
389         IF(lwp) THEN
390            if (jriver_si.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: Si CONC data read'
391            if (jriver_si.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: Si FLUX data read'
392         ENDIF
393         CALL iom_close ( numriv )
394         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river Si file closed'
395      else
396         IF(lwp) THEN
397            WRITE(numout,*) ' **** trc_ini_medusa_river: Si data NOT read'
398         ENDIF
399      endif
400      !!
401      if (jriver_c.gt.0) then
402         if (jriver_c.eq.1) CALL iom_open ( 'river_C_conc_orca100.nc', numriv )
403         if (jriver_c.eq.2) CALL iom_open ( 'river_C_flux_orca100.nc', numriv )
404         CALL iom_get  ( numriv, jpdom_data, 'RIV_C', riv_c )
405         IF(lwp) THEN
406            if (jriver_c.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: C CONC data read'
407            if (jriver_c.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: C FLUX data read'
408         ENDIF
409         CALL iom_close ( numriv )
410         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river C file closed'
411      else
412         IF(lwp) THEN
413            WRITE(numout,*) ' **** trc_ini_medusa_river: C data NOT read'
414         ENDIF
415      endif
416      !!
417      if (jriver_alk.gt.0) then
418         if (jriver_alk.eq.1) CALL iom_open ( 'river_alk_conc_orca100.nc', numriv )
419         if (jriver_alk.eq.2) CALL iom_open ( 'river_alk_flux_orca100.nc', numriv )
420         CALL iom_get  ( numriv, jpdom_data, 'RIV_ALK', riv_alk )
421         IF(lwp) THEN
422            if (jriver_alk.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity CONC data read'
423            if (jriver_alk.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity FLUX data read'
424         ENDIF
425         CALL iom_close ( numriv )
426         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river alkalinity file closed'
427      else
428         IF(lwp) THEN
429            WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity data NOT read'
430         ENDIF
431      endif
432      IF(lwp) CALL flush(numout)
433
434   END SUBROUTINE trc_ini_medusa_river
435   
436#else
437   !!----------------------------------------------------------------------
438   !!   Dummy module                                        No MEDUSA model
439   !!----------------------------------------------------------------------
440CONTAINS
441   SUBROUTINE trc_ini_medusa             ! Empty routine
442   END SUBROUTINE trc_ini_medusa
443#endif
444
445   !!======================================================================
446END MODULE trcini_medusa
Note: See TracBrowser for help on using the repository browser.