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_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90 @ 5710

Last change on this file since 5710 was 5710, checked in by acc, 9 years ago

Branch NERC/dev_r5107_NOC_MEDUSA. Removed SVN keyword updating and cleared existing expansions.
File size: 16.3 KB
RevLine 
[5707]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)
[5710]47   !! $Id$
[5707]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
299      !!---------------------------------------------------------------------
300
301      !! Open the file
302      !! -------------
303      !!
304      IF(lwp) WRITE(numout,*) ' '
305      IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd'
306      CALL iom_open ( 'ccd_ocal_nemo.nc', numccd )
307      IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc opened'
308
309      !! Read the data
310      !! -------------
311      !!
312      CALL iom_get ( numccd, jpdom_data, 'OCAL_CCD', ocal_ccd )
313      IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: data read'
314
315      !! Close the file
316      !! --------------
317      !!
318      CALL iom_close ( numccd )
319      IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc closed'
320      IF(lwp) CALL flush(numout)
321     
322   END SUBROUTINE trc_ini_medusa_ccd
323
324   !! ======================================================================
325   !! ======================================================================
326   !! ======================================================================
327
328   !! AXY (26/01/12)
329   SUBROUTINE trc_ini_medusa_river(kt)
330
331      !!----------------------------------------------------------------------
332      !!                  ***  ROUTINE trc_ini_medusa_river  ***
333      !!
334      !! ** Purpose :   Read riverine nutrient fields
335      !!
336      !! ** Method  :   Read the file
337      !!
338      !! ** input   :   external netcdf files
339      !!
340      !!----------------------------------------------------------------------
341      !! * arguments
342      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
343
344      !!---------------------------------------------------------------------
345
346      IF(lwp) THEN
347         WRITE(numout,*) ' '
348         WRITE(numout,*) ' **** Routine trc_ini_medusa_river'
349         WRITE(numout,*) ' '
350      ENDIF
351
352      !! Open and read the files
353      !! -----------------------
354      !!
355      if (jriver_n.gt.0) then
356         if (jriver_n.eq.1) CALL iom_open ( 'river_N_conc_orca100.nc', numriv )
357         if (jriver_n.eq.2) CALL iom_open ( 'river_N_flux_orca100.nc', numriv )
358         CALL iom_get  ( numriv, jpdom_data, 'RIV_N', riv_n )
359         IF(lwp) THEN
360            if (jriver_n.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: N CONC data read'
361            if (jriver_n.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: N FLUX data read'
362         ENDIF
363         CALL iom_close ( numriv )
364         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river N file closed'
365      else
366         IF(lwp) THEN
367            WRITE(numout,*) ' **** trc_ini_medusa_river: N data NOT read'
368         ENDIF
369      endif
370      !!
371      if (jriver_si.gt.0) then
372         if (jriver_si.eq.1) CALL iom_open ( 'river_Si_conc_orca100.nc', numriv )
373         if (jriver_si.eq.2) CALL iom_open ( 'river_Si_flux_orca100.nc', numriv )
374         CALL iom_get  ( numriv, jpdom_data, 'RIV_SI', riv_si )
375         IF(lwp) THEN
376            if (jriver_si.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: Si CONC data read'
377            if (jriver_si.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: Si FLUX data read'
378         ENDIF
379         CALL iom_close ( numriv )
380         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river Si file closed'
381      else
382         IF(lwp) THEN
383            WRITE(numout,*) ' **** trc_ini_medusa_river: Si data NOT read'
384         ENDIF
385      endif
386      !!
387      if (jriver_c.gt.0) then
388         if (jriver_c.eq.1) CALL iom_open ( 'river_C_conc_orca100.nc', numriv )
389         if (jriver_c.eq.2) CALL iom_open ( 'river_C_flux_orca100.nc', numriv )
390         CALL iom_get  ( numriv, jpdom_data, 'RIV_C', riv_c )
391         IF(lwp) THEN
392            if (jriver_c.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: C CONC data read'
393            if (jriver_c.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: C FLUX data read'
394         ENDIF
395         CALL iom_close ( numriv )
396         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river C file closed'
397      else
398         IF(lwp) THEN
399            WRITE(numout,*) ' **** trc_ini_medusa_river: C data NOT read'
400         ENDIF
401      endif
402      !!
403      if (jriver_alk.gt.0) then
404         if (jriver_alk.eq.1) CALL iom_open ( 'river_alk_conc_orca100.nc', numriv )
405         if (jriver_alk.eq.2) CALL iom_open ( 'river_alk_flux_orca100.nc', numriv )
406         CALL iom_get  ( numriv, jpdom_data, 'RIV_ALK', riv_alk )
407         IF(lwp) THEN
408            if (jriver_alk.eq.1) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity CONC data read'
409            if (jriver_alk.eq.2) WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity FLUX data read'
410         ENDIF
411         CALL iom_close ( numriv )
412         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_river: river alkalinity file closed'
413      else
414         IF(lwp) THEN
415            WRITE(numout,*) ' **** trc_ini_medusa_river: alkalinity data NOT read'
416         ENDIF
417      endif
418      IF(lwp) CALL flush(numout)
419
420   END SUBROUTINE trc_ini_medusa_river
421   
422#else
423   !!----------------------------------------------------------------------
424   !!   Dummy module                                        No MEDUSA model
425   !!----------------------------------------------------------------------
426CONTAINS
427   SUBROUTINE trc_ini_medusa             ! Empty routine
428   END SUBROUTINE trc_ini_medusa
429#endif
430
431   !!======================================================================
432END MODULE trcini_medusa
Note: See TracBrowser for help on using the repository browser.