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.
trcnam_medusa.F90_save 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/trcnam_medusa.F90_save @ 5707

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

JPALM --25-08-2015 -- add MEDUSA in the branch. MEDUSA version already up-to-date with this trunk revision

File size: 47.7 KB
Line 
1MODULE trcnam_medusa
2   !!======================================================================
3   !!                      ***  MODULE trcnam_medusa  ***
4   !! TOP :   initialisation of some run parameters for MEDUSA bio-model
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   !!              -   !  2013-05  (A. Yool) renamed (from trclsm) for v3.5
12   !!----------------------------------------------------------------------
13#if defined key_medusa
14   !!----------------------------------------------------------------------
15   !!   'key_medusa'   :                                       MEDUSA model
16   !!----------------------------------------------------------------------
17   !! trc_nam_medusa      : MEDUSA model initialisation
18   !!----------------------------------------------------------------------
19   USE oce_trc         ! Ocean variables
20   USE par_trc         ! TOP parameters
21   USE trc             ! TOP variables
22   USE sms_medusa      ! sms trends
23   USE iom             ! I/O manager
24
25   !! AXY (04/02/14): necessary to find NaNs on HECTOR
26   USE, INTRINSIC :: ieee_arithmetic
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   trc_nam_medusa   ! called by trcnam.F90 module
32
33   !!* Substitution
34#  include "domzgr_substitute.h90"
35   !!----------------------------------------------------------------------
36   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
37   !! $Id: trcnam_medusa.F90 1162 2008-07-02 09:33:33Z cetlod $
38   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
39   !!----------------------------------------------------------------------
40
41CONTAINS
42
43   SUBROUTINE trc_nam_medusa
44      !!----------------------------------------------------------------------
45      !!                     ***  trc_nam_medusa  *** 
46      !!
47      !! ** Purpose :   read MEDUSA namelist
48      !!
49      !! ** input   :   file 'namelist.trc.sms' containing the following
50      !!             namelist: natbio, natopt, and natdbi ("key_trc_diabio")
51      !!
52      !! ekp: namelist nabio contains ALL parameters of the ecosystem
53      !!      point sourses and sinks PLUS sediment exchange
54      !!      dia_bio - used by Lobster to output all point terms
55      !!                (sourses and sinks of bio)
56      !!      dia_add - additional diagnostics for biology such as
57      !!                primary production (2d depth integrated field or 3d)
58      !!----------------------------------------------------------------------
59      !!
60      INTEGER            :: ji,jj,jk
61      REAL(wp)           :: fthk, fdep, fdep1
62      REAL(wp)           :: q1, q2, q3
63      !
64      NAMELIST/natbio/ xxi,xaln,xald,jphy,xvpn,xvpd,          &
65      &    xsin0,xnsi0,xuif,jliebig,                          &
66      &    xthetam,xthetamd,xnln,xnld,xsld,xfln,xfld,         &
67      &  xgmi,xgme,xkmi,xkme,xphi,xbetan,xbetac,xkc,          &
68      &    xpmipn,xpmid,xpmepn,xpmepd,xpmezmi,xpmed,          &
69      &  xmetapn,xmetapd,xmetazmi,xmetazme,                   &
70      &  jmpn,xmpn,xkphn,jmpd,xmpd,xkphd,jmzmi,xmzmi,xkzmi,   &
71      &    jmzme,xmzme,xkzme,jmd,jsfd,xmd,xmdc,               &
72      &  xthetapn,xthetapd,xthetazmi,xthetazme,xthetad,       &
73      &    xrfn,xrsn,vsed,xhr,                                &
74      &  jiron,xfe_mass,xfe_sol,xfe_sed,xLgT,xk_FeL,xk_sc_Fe, &
75      &  jexport,jfdfate,jrratio,jocalccd,xridg_r0,           &
76      &    xfdfrac1,xfdfrac2,xfdfrac3,                        &
77      &    xcaco3a,xcaco3b,xmassc,xmassca,xmasssi,xprotca,    &
78      &    xprotsi,xfastc,xfastca,xfastsi,                    &
79      &  jorgben,jinorgben,xsedn,xsedfe,xsedsi,xsedc,xsedca,  &
80      &    xburial,                                           &
81      &  jriver_n,jriver_si,jriver_c,jriver_alk,jriver_dep,   &
82      &    friver_dep,                                        &
83      &  xsdiss,                                              &
84      &  vsed,xhr,                                            &
85      &  sedlam,sedlostpoc,jpkb,jdms
86#if defined key_roam
87      NAMELIST/natroam/ xthetaphy,xthetazoo,xthetanit,        &
88      &    xthetarem,xo2min,                                  &
89      &    f3_pH,f3_h2co3,f3_hco3,f3_co3,f3_omcal,f3_omarg,   &
90      &    f2_ccd_cal,f2_ccd_arg
91#endif
92      NAMELIST/natopt/xkg0,xkr0,xkgp,xkrp,xlg,xlr,rpig
93      INTEGER :: jl, jn
94      TYPE(DIAG), DIMENSION(jp_medusa_2d)  :: meddia2d
95      TYPE(DIAG), DIMENSION(jp_medusa_3d)  :: meddia3d
96      TYPE(DIAG), DIMENSION(jp_medusa_trd) :: meddiabio
97      CHARACTER(LEN=32)   ::   clname
98      !!
99      NAMELIST/nammeddia/ meddia3d, meddia2d     ! additional diagnostics
100
101      !!----------------------------------------------------------------------
102
103      IF(lwp) WRITE(numout,*)
104      clname = 'namelist_medusa'
105      IF(lwp) WRITE(numout,*) ' trc_nam_medusa: read MEDUSA namelist'
106      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
107# if defined key_debug_medusa
108      CALL flush(numout)
109# endif
110
111
112      CALL ctl_opn( numnatm, TRIM( clname ), 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
113
114# if defined key_debug_medusa
115      CALL flush(numout)
116      IF (lwp) write (numout,*) '------------------------------'
117      IF (lwp) write (numout,*) 'Jpalm - debug'
118      IF (lwp) write (numout,*) 'open namelist_medusa -- OK'
119      IF (lwp) write (numout,*) 'Now, read namilists inside :'
120      IF (lwp) write (numout,*) ' '
121# endif
122      !
123!     IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN
124! should be done via iom_put exclusively but there are a lot of them; this is the easy first attempt !
125         !
126         ! Namelist nammeddia
127         ! -------------------
128         DO jl = 1, jp_medusa_2d
129            WRITE(meddia2d(jl)%sname,'("2D_",I1)') jl                      ! short name
130            WRITE(meddia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name
131            meddia2d(jl)%units = ' '                                       ! units
132         END DO
133# if defined key_debug_medusa
134      CALL flush(numout)
135# endif
136         !                                 ! 3D output arrays
137         DO jl = 1, jp_medusa_3d
138            WRITE(meddia3d(jl)%sname,'("3D_",I1)') jl                      ! short name
139            WRITE(meddia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name
140            meddia3d(jl)%units = ' '                                       ! units
141         END DO
142# if defined key_debug_medusa
143      IF (lwp) write (numout,*) '------------------------------'
144      IF (lwp) write (numout,*) 'Jpalm - debug'
145      IF (lwp) write (numout,*) 'Just before reading namelist_medusa :: nammeddia'
146      IF (lwp) write (numout,*) ' '
147      CALL flush(numout)
148# endif
149
150         REWIND( numnatm )               !
151         READ  ( numnatm, nammeddia )
152
153# if defined key_debug_medusa
154      IF (lwp) write (numout,*) '------------------------------'
155      IF (lwp) write (numout,*) 'Jpalm - debug'
156      IF (lwp) write (numout,*) 'reading namelist_medusa :: nammeddia OK'
157      IF (lwp) write (numout,*) 'Check number of variable in nammeddia:'
158      IF (lwp) write (numout,*) 'jp_medusa_2d: ',jp_medusa_2d ,'jp_medusa_3d: ',jp_medusa_3d
159      IF (lwp) write (numout,*) ' '
160      CALL flush(numout)
161# endif
162         DO jl = 1, jp_medusa_2d
163            jn = jp_msa0_2d + jl - 1
164            ctrc2d(jn) = meddia2d(jl)%sname
165            ctrc2l(jn) = meddia2d(jl)%lname
166            ctrc2u(jn) = meddia2d(jl)%units
167         END DO
168
169         DO jl = 1, jp_medusa_3d
170            jn = jp_msa0_3d + jl - 1
171            ctrc3d(jn) = meddia3d(jl)%sname
172            ctrc3l(jn) = meddia3d(jl)%lname
173            ctrc3u(jn) = meddia3d(jl)%units
174         END DO
175
176         IF(lwp) THEN                   ! control print
177# if defined key_debug_medusa
178      IF (lwp) write (numout,*) '------------------------------'
179      IF (lwp) write (numout,*) 'Jpalm - debug'
180      IF (lwp) write (numout,*) 'Var name assignation OK'
181      IF (lwp) write (numout,*) 'next check var names'
182      IF (lwp) write (numout,*) ' '
183            CALL flush(numout)
184# endif
185            WRITE(numout,*)
186            WRITE(numout,*) ' Namelist : natadd'
187            DO jl = 1, jp_medusa_3d
188               jn = jp_msa0_3d + jl - 1
189               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), &
190                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn)
191            END DO
192            WRITE(numout,*) ' '
193
194            DO jl = 1, jp_medusa_2d
195               jn = jp_msa0_2d + jl - 1
196               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), &
197                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn)
198            END DO
199            WRITE(numout,*) ' '
200         ENDIF
201         !
202# if defined key_debug_medusa
203            CALL flush(numout)
204# endif
205
206!     ENDIF
207
208      ! 1.4 namelist natbio : biological parameters
209      ! -------------------------------------------
210     
211      xxi         = 0.
212      xaln        = 0.
213      xald        = 0.
214      jphy        = 0
215      xvpn        = 0.
216      xvpd        = 0.
217      xthetam     = 0.
218      xthetamd    = 0.
219!!
220      xsin0       = 0.
221      xnsi0       = 0.
222      xuif        = 0.
223!!
224      jliebig     = 0
225      xnln        = 0.
226      xnld        = 0.
227      xsld        = 0.
228      xfln        = 0.
229      xfld        = 0.
230!!
231      xgmi        = 0.
232      xgme        = 0.
233      xkmi        = 0.
234      xkme        = 0.
235      xphi    = 0.
236      xbetan      = 0.
237      xbetac      = 0.
238      xkc         = 0.
239      xpmipn      = 0.
240      xpmid       = 0.
241      xpmepn      = 0.
242      xpmepd      = 0.
243      xpmezmi     = 0.
244      xpmed       = 0.
245!!
246      xmetapn     = 0.
247      xmetapd     = 0.
248      xmetazmi    = 0.
249      xmetazme    = 0.
250!!
251      jmpn        = 0
252      xmpn        = 0.
253      xkphn       = 0.
254      jmpd        = 0
255      xmpd        = 0.
256      xkphd       = 0.
257      jmzmi       = 0
258      xmzmi       = 0.
259      xkzmi       = 0.
260      jmzme       = 0
261      xmzme       = 0.
262      xkzme       = 0.
263!!
264      jmd         = 0
265      jsfd        = 0
266      xmd         = 0.
267      xmdc        = 0.
268!!
269      xthetapn    = 0.
270      xthetapd    = 0.
271      xthetazmi   = 0.
272      xthetazme   = 0.
273      xthetad     = 0.
274      xrfn        = 0.
275      xrsn        = 0.  !: (NOT USED HERE; RETAINED FOR LOBSTER)
276!!
277      jiron       = 0
278      xfe_mass    = 0.
279      xfe_sol     = 0.
280      xfe_sed     = 0.
281      xLgT        = 0.
282      xk_FeL     = 0.
283      xk_sc_Fe    = 0.
284!!
285      jexport     = 0
286      jfdfate     = 0
287      jrratio     = 0
288      jocalccd    = 0
289      xridg_r0    = 0.
290      xfdfrac1   = 0.
291      xfdfrac2   = 0.
292      xfdfrac3   = 0.
293      xcaco3a    = 0.
294      xcaco3b    = 0.
295      xmassc     = 0.
296      xmassca    = 0.
297      xmasssi    = 0.
298      xprotca    = 0.
299      xprotsi    = 0.
300      xfastc     = 0.
301      xfastca    = 0.
302      xfastsi    = 0.
303!!
304      jorgben     = 0
305      jinorgben   = 0
306      xsedn       = 0.
307      xsedfe      = 0.
308      xsedsi      = 0.
309      xsedc       = 0.
310      xsedca      = 0.
311      xburial     = 0.
312!!
313      jriver_n    = 0
314      jriver_si   = 0
315      jriver_c    = 0
316      jriver_alk  = 0
317      jriver_dep  = 1
318!!
319      xsdiss     = 0.
320!!
321      vsed        = 0.
322      xhr         = 0.
323!!
324      sedlam     = 0.
325      sedlostpoc  = 0.
326      jpkb    = 0.
327      jdms        = 0
328           
329      REWIND(numnatm)
330      READ(numnatm,natbio)
331
332!! Primary production and chl related quantities
333!!       xxi         :  conversion factor from gC to mmolN
334!!       xaln        :  Chl-a specific initial slope of P-I curve for non-diatoms
335!!       xald        :  Chl-a specific initial slope of P-I curve for diatoms
336!!       jphy        :  phytoplankton T-dependent growth switch
337!!       xvpn        :  maximum growth rate for non-diatoms
338!!       xvpd        :  maximum growth rate for diatoms
339!!       xthetam     :  maximum Chl to C ratio for non-diatoms     
340!!       xthetamd    :  maximum Chl to C ratio for diatoms     
341!!
342!! Diatom silicon parameters
343!!       xsin0       :  minimum diatom Si:N ratio
344!!       xnsi0       :  minimum diatom N:Si ratio
345!!       xuif        :  hypothetical growth ratio at infinite Si:N ratio
346!!
347!! Nutrient limitation
348!!       jliebig     :  Liebig nutrient uptake switch
349!!       xnln        :  half-sat constant for DIN uptake by non-diatoms
350!!       xnld        :  half-sat constant for DIN uptake by diatoms
351!!       xsl         :  half-sat constant for Si uptake by diatoms
352!!       xfld        :  half-sat constant for Fe uptake by diatoms 
353!!       xfln        :  half-sat constant for Fe uptake by non-datoms
354!!
355!! Grazing
356!!       xgmi        :  microzoo maximum growth rate
357!!       xgme        :  mesozoo maximum growth rate
358!!       xkmi        :  microzoo grazing half-sat parameter
359!!       xkme        :  mesozoo grazing half-sat parameter
360!!       xphi        :  micro/mesozoo grazing inefficiency
361!!       xbetan      :  micro/mesozoo N assimilation efficiency
362!!       xbetac      :  micro/mesozoo C assimilation efficiency
363!!       xkc         :  micro/mesozoo net C growth efficiency
364!!       xpmipn      :  grazing preference of microzoo for non-diatoms
365!!       xpmid       :  grazing preference of microzoo for diatoms
366!!       xpmepn      :  grazing preference of mesozoo for non-diatoms
367!!       xpmepd      :  grazing preference of mesozoo for diatoms
368!!       xpmezmi     :  grazing preference of mesozoo for microzoo
369!!       xpmed       :  grazing preference of mesozoo for detritus
370!!
371!! Metabolic losses
372!!       xmetapn     :  non-diatom metabolic loss rate
373!!       xmetapd     :  diatom     metabolic loss rate
374!!       xmetazmi    :  microzoo   metabolic loss rate
375!!       xmetazme    :  mesozoo    metabolic loss rate
376!!
377!! Mortality/Remineralisation
378!!       jmpn        :  non-diatom mortality functional form
379!!       xmpn        :  non-diatom mortality rate
380!!       xkphn       :  non-diatom mortality half-sat constant
381!!       jmpd        :  diatom     mortality functional form
382!!       xmpd        :  diatom mortality rate
383!!       xkphd       :  diatom mortality half-sat constant
384!!       jmzmi       :  microzoo   mortality functional form
385!!       xmzmi       :  microzoo mortality rate
386!!       xkzmi       :  microzoo mortality half-sat constant
387!!       jmzme       :  mesozoo    mortality functional form
388!!       xmzme       :  mesozoo mortality rate
389!!       xkzme       :  mesozoo mortality half-sat constant
390!!
391!! Remineralisation
392!!       jmd         :  detritus T-dependent remineralisation switch
393!!       jsfd        :  accelerate seafloor detritus remin. switch
394!!       xmd         :  detrital nitrogen remineralisation rate
395!!       xmdc        :  detrital carbon remineralisation rate
396!!
397!! Stochiometric ratios
398!!       xthetapn    :  non-diatom C:N ratio
399!!       xthetapd    :  diatom C:N ratio
400!!       xthetazmi   :  microzoo C:N ratio
401!!       xthetazme   :  mesozoo C:N ratio
402!!       xthetad     :  detritus C:N ratio
403!!       xrfn        :  phytoplankton Fe:N ratio
404!!  xrsn        :  diatom Si:N ratio (*NOT* used)
405!!
406!! Iron parameters
407!!       jiron       :  iron scavenging submodel switch
408!!       xfe_mass    :  iron atomic mass
409!!  xfe_sol     :  aeolian iron solubility
410!!  xfe_sed     :  sediment iron input
411!!  xLgT      :  total ligand concentration (umol/m3)
412!!  xk_FeL       :  dissociation constant for (Fe + L)
413!!  xk_sc_Fe    :  scavenging rate of "free" iron
414!! 
415!! Fast-sinking detritus parameters
416!!       jexport     :  fast detritus remineralisation switch
417!!       jfdfate     :  fate of fast detritus at seafloor switch
418!!       jrratio     :  rain ratio switch
419!!       jocalccd    :  CCD switch
420!!       xridg_r0    :  Ridgwell rain ratio coefficient
421!!       xfdfrac1    :  fast-sinking fraction of diatom nat. mort. losses
422!!       xfdfrac2    :  fast-sinking fraction of meszooplankton mort. losses
423!!       xfdfrac3    :  fast-sinking fraction of diatom silicon grazing losses
424!!       xcaco3a     :  polar (high latitude) CaCO3 fraction
425!!       xcaco3b     :  equatorial (low latitude) CaCO3 fraction
426!!       xmassc      :  organic C mass:mole ratio, C106 H175 O40 N16 P1
427!!       xmassca     :  calcium carbonate mass:mole ratio, CaCO3
428!!       xmasssi     :  biogenic silicon mass:mole ratio, (H2SiO3)n
429!!       xprotca     :  calcium carbonate protection ratio
430!!       xprotsi     :  biogenic silicon protection ratio
431!!       xfastc      :  organic C remineralisation length scale
432!!       xfastca     :  calcium carbonate dissolution length scale
433!!       xfastsi     :  biogenic silicon dissolution length scale
434!!
435!! Benthic
436!!       jorgben     :  does   organic detritus go to the benthos?
437!!       jinorgben   :  does inorganic detritus go to the benthos?
438!!       xsedn       :  organic   nitrogen sediment remineralisation rate
439!!       xsedfe      :  organic   iron     sediment remineralisation rate
440!!       xsedsi      :  inorganic silicon  sediment dissolution      rate
441!!       xsedc       :  organic   carbon   sediment remineralisation rate
442!!       xsedca      :  inorganic carbon   sediment dissolution      rate
443!!       xburial     :  burial rate of seafloor detritus
444!!
445!! Riverine inputs
446!!       jriver_n    :  riverine N          input?
447!!       jriver_si   :  riverine Si         input?
448!!       jriver_c    :  riverine C          input?
449!!       jriver_alk  :  riverine alkalinity input?
450!!       jriver_dep  :  depth of riverine   input?
451!!
452!! Miscellaneous
453!!       xsdiss      :  diatom frustule dissolution rate
454!!
455!! Gravitational sinking     
456!!       vsed        :  detritus gravitational sinking rate
457!!       xhr         :  coeff for Martin's remineralisation profile
458!!
459!! Additional parameters
460!!       sedlam      :  time coeff of POC in sediments
461!!      sedlostpoc   :  sediment geol loss for POC
462!!       jpkb        :  vertical layer for diagnostic of the vertical flux
463!!                      NOTE that in LOBSTER it is a first vertical layers where
464!!                      biology is active 
465!!
466!! UKESM1 - new diagnostics  !! Jpalm
467!!       jdms        :  include dms diagnostics
468!!
469!!
470!!
471
472      IF(lwp) THEN
473!!
474!! AXY (08/11/13): compilation key notification
475         WRITE(numout,*) '=== Compilation keys'
476#if defined key_roam
477         WRITE(numout,*)     &
478         &   ' key_roam                                                               = ACTIVE'
479#else
480         WRITE(numout,*)     &
481         &   ' key_roam                                                               = INACTIVE'
482#endif       
483#if defined key_axy_carbchem
484         WRITE(numout,*)     &
485         &   ' key_axy_carbchem                                                       = ACTIVE'
486#else
487         WRITE(numout,*)     &
488         &   ' key_axy_carbchem                                                       = INACTIVE'
489#endif       
490#if defined key_bs_axy_zforce
491         WRITE(numout,*)     &
492         &   ' key_bs_axy_zforce                                                      = ACTIVE'
493#else
494         WRITE(numout,*)     &
495         &   ' key_bs_axy_zforce                                                      = INACTIVE'
496#endif       
497#if defined key_bs_axy_yrlen
498         WRITE(numout,*)     &
499         &   ' key_bs_axy_yrlen                                                       = ACTIVE'
500#else
501         WRITE(numout,*)     &
502         &   ' key_bs_axy_yrlen                                                       = INACTIVE'
503#endif       
504#if defined key_deep_fe_fix
505         WRITE(numout,*)     &
506         &   ' key_deep_fe_fix                                                        = ACTIVE'
507#else
508         WRITE(numout,*)     &
509         &   ' key_deep_fe_fix                                                        = INACTIVE'
510#endif       
511#if defined key_axy_nancheck
512         WRITE(numout,*)     &
513         &   ' key_axy_nancheck                                                       = ACTIVE'
514#else
515         WRITE(numout,*)     &
516         &   ' key_axy_nancheck                                                       = INACTIVE'
517#endif       
518# if defined key_axy_pi_co2
519         WRITE(numout,*)     &
520         &   ' key_axy_pi_co2                                                         = ACTIVE'
521#else
522         WRITE(numout,*)     &
523         &   ' key_axy_pi_co2                                                         = INACTIVE'
524# endif
525         WRITE(numout,*) ' '
526
527         WRITE(numout,*) 'natbio'
528         WRITE(numout,*) ' '
529!!
530!! Primary production and chl related quantities
531         WRITE(numout,*) '=== Primary production'
532         WRITE(numout,*)     &
533         &   ' conversion factor from gC to mmolN,                        xxi         =', xxi
534         WRITE(numout,*)     &
535         &   ' Chl-a specific initial slope of P-I curve for non-diatoms, xaln        = ', xaln
536         WRITE(numout,*)     &
537         &   ' Chl-a specific initial slope of P-I curve for diatoms,     xald        = ', xald
538         if (jphy.eq.1) then
539            WRITE(numout,*) &
540            &   ' phytoplankton growth is *temperature-dependent*            jphy        = ', jphy
541         elseif (jphy.eq.0) then
542            WRITE(numout,*) &
543            &   ' phytoplankton growth is *temperature-independent*          jphy        = ', jphy
544         endif
545         WRITE(numout,*)     &
546         &   ' maximum growth rate for non-diatoms,                       xvpn        = ', xvpn
547         WRITE(numout,*)     &
548         &   ' maximum growth rate for diatoms,                           xvpn        = ', xvpd
549         WRITE(numout,*)     &
550         &   ' maximum Chl to C ratio for non-diatoms,                    xthetam     = ', xthetam
551         WRITE(numout,*)     &
552         &   ' maximum Chl to C ratio for diatoms,                        xthetamd    = ', xthetamd
553!!
554!! Diatom silicon parameters
555         WRITE(numout,*) '=== Diatom silicon parameters'
556         WRITE(numout,*)     &
557         &   ' minimum diatom Si:N ratio,                                 xsin0       = ', xsin0
558         WRITE(numout,*)     &
559         &   ' minimum diatom N:Si ratio,                                 xnsi0       = ', xnsi0
560         WRITE(numout,*)     &
561         &   ' hypothetical growth ratio at infinite Si:N ratio,          xuif        = ', xuif
562!!
563!! Nutrient limitation
564         WRITE(numout,*) '=== Nutrient limitation'
565         if (jliebig.eq.1) then
566            WRITE(numout,*) &
567            &   ' nutrient uptake is a Liebig Law (= most limiting) function jliebig     = ', jliebig
568         elseif (jliebig.eq.0) then
569            WRITE(numout,*) &
570            &   ' nutrient uptake is a multiplicative function               jliebig     = ', jliebig
571         endif
572         WRITE(numout,*)     &
573         &   ' half-sat constant for DIN uptake by non-diatoms,           xnln        = ', xnln
574         WRITE(numout,*)     &
575         &   ' half-sat constant for DIN uptake by diatoms,               xnld        = ', xnld
576         WRITE(numout,*)     &
577         &   ' half-sat constant for Si uptake by diatoms,                xsld        = ', xsld
578         WRITE(numout,*)     &
579         &   ' half-sat constant for Fe uptake by non-diatoms,            xfln        = ', xfln
580         WRITE(numout,*)     &
581         &   ' half-sat constant for Fe uptake by diatoms,                xfld        = ', xfld
582!!
583!! Grazing
584         WRITE(numout,*) '=== Zooplankton grazing'
585         WRITE(numout,*)     &
586         &   ' microzoo maximum growth rate,                              xgmi        = ', xgmi
587         WRITE(numout,*)     &
588         &   ' mesozoo maximum growth rate,                               xgme        = ', xgme
589         WRITE(numout,*)     &
590         &   ' microzoo grazing half-sat parameter,                       xkmi        = ', xkmi
591         WRITE(numout,*)     &
592         &   ' mesozoo grazing half-sat parameter,                        xkme        = ', xkme
593         WRITE(numout,*)     &
594         &   ' micro/mesozoo grazing inefficiency,                        xphi        = ', xphi
595         WRITE(numout,*)     &
596         &   ' micro/mesozoo N assimilation efficiency,                   xbetan      = ', xbetan
597         WRITE(numout,*)     &
598         &   ' micro/mesozoo C assimilation efficiency,                   xbetac      = ', xbetan
599         WRITE(numout,*)     &
600         &   ' micro/mesozoo net C growth efficiency,                     xkc         = ', xkc
601         WRITE(numout,*)     &
602         &   ' grazing preference of microzoo for non-diatoms,            xpmipn      = ', xpmipn
603         WRITE(numout,*)     &
604         &   ' grazing preference of microzoo for detritus,               xpmid       = ', xpmid
605         WRITE(numout,*)     &
606         &   ' grazing preference of mesozoo for non-diatoms,             xpmepn      = ', xpmepn
607         WRITE(numout,*)     &
608         &   ' grazing preference of mesozoo for diatoms,                 xpmepd      = ', xpmepd
609         WRITE(numout,*)     &
610         &   ' grazing preference of mesozoo for microzoo,                xpmezmi     = ', xpmezmi
611         WRITE(numout,*)     &
612         &   ' grazing preference of mesozoo for detritus,                xpmed       = ', xpmed
613!!
614!! Metabolic losses
615         WRITE(numout,*) '=== Metabolic losses'
616         WRITE(numout,*)     &
617         &   ' non-diatom metabolic loss rate,                            xmetapn     = ', xmetapn
618         WRITE(numout,*)     &
619         &   ' diatom     metabolic loss rate,                            xmetapd     = ', xmetapd
620         WRITE(numout,*)     &
621         &   ' microzoo   metabolic loss rate,                            xmetazmi    = ', xmetazmi
622         WRITE(numout,*)     &
623         &   ' mesozoo    metabolic loss rate,                            xmetazme    = ', xmetazme
624!!
625!! Mortality losses
626         WRITE(numout,*) '=== Mortality losses'
627         if (jmpn.eq.1) then
628            WRITE(numout,*)     &
629            &   ' non-diatom mortality functional form,            LINEAR    jmpn        = ', jmpn
630         elseif (jmpn.eq.2) then
631            WRITE(numout,*)     &
632            &   ' non-diatom mortality functional form,         QUADRATIC    jmpn        = ', jmpn
633         elseif (jmpn.eq.3) then
634            WRITE(numout,*)     &
635            &   ' non-diatom mortality functional form,        HYPERBOLIC    jmpn        = ', jmpn
636         elseif (jmpn.eq.4) then
637            WRITE(numout,*)     &
638            &   ' non-diatom mortality functional form,           SIGMOID    jmpn        = ', jmpn
639         endif
640         WRITE(numout,*)     &
641         &   ' non-diatom mortality rate,                                 xmpn        = ', xmpn
642         WRITE(numout,*)     &
643         &   ' non-diatom mortality half-sat constant                     xkphn       = ', xkphn
644         if (jmpd.eq.1) then
645            WRITE(numout,*)     &
646            &   ' diatom mortality functional form,                LINEAR    jmpd        = ', jmpd
647         elseif (jmpd.eq.2) then
648            WRITE(numout,*)     &
649            &   ' diatom mortality functional form,             QUADRATIC    jmpd        = ', jmpd
650         elseif (jmpd.eq.3) then
651            WRITE(numout,*)     &
652            &   ' diatom mortality functional form,            HYPERBOLIC    jmpd        = ', jmpd
653         elseif (jmpd.eq.4) then
654            WRITE(numout,*)     &
655            &   ' diatom mortality functional form,               SIGMOID    jmpd        = ', jmpd
656         endif
657         WRITE(numout,*)     &
658         &   ' diatom mortality rate,                                     xmpd        = ', xmpd
659         WRITE(numout,*)     &
660         &   ' diatom mortality half-sat constant                         xkphd       = ', xkphd
661         if (jmzmi.eq.1) then
662            WRITE(numout,*)     &
663            &   ' microzoo mortality functional form,              LINEAR    jmzmi       = ', jmzmi
664         elseif (jmzmi.eq.2) then
665            WRITE(numout,*)     &
666            &   ' microzoo mortality functional form,           QUADRATIC    jmzmi       = ', jmzmi
667         elseif (jmzmi.eq.3) then
668            WRITE(numout,*)     &
669            &   ' microzoo mortality functional form,          HYPERBOLIC    jmzmi       = ', jmzmi
670         elseif (jmzmi.eq.4) then
671            WRITE(numout,*)     &
672            &   ' microzoo mortality functional form,             SIGMOID    jmzmi       = ', jmzmi
673         endif
674         WRITE(numout,*)     &
675         &   ' microzoo mortality rate,                                   xmzmi       = ', xmzmi
676         WRITE(numout,*)     &
677         &   ' mesozoo mortality half-sat constant,                       xkzmi       = ', xkzmi
678         if (jmzme.eq.1) then
679            WRITE(numout,*)     &
680            &   ' mesozoo mortality functional form,               LINEAR    jmzme       = ', jmzme
681         elseif (jmzme.eq.2) then
682            WRITE(numout,*)     &
683            &   ' mesozoo mortality functional form,            QUADRATIC    jmzme       = ', jmzme
684         elseif (jmzme.eq.3) then
685            WRITE(numout,*)     &
686            &   ' mesozoo mortality functional form,           HYPERBOLIC    jmzme       = ', jmzme
687         elseif (jmzme.eq.4) then
688            WRITE(numout,*)     &
689            &   ' mesozoo mortality functional form,              SIGMOID    jmzme       = ', jmzme
690         endif
691         WRITE(numout,*)     &
692         &   ' mesozoo mortality rate,                                    xmzme       = ', xmzme
693         WRITE(numout,*)     &
694         &   ' mesozoo mortality half-sat constant,                       xkzme       = ', xkzme
695!!
696!! Remineralisation
697         WRITE(numout,*) '=== Remineralisation'
698         if (jmd.eq.1) then
699            WRITE(numout,*) &
700            &   ' detritus remineralisation is *temperature-dependent*       jmd         = ', jmd
701         elseif (jmd.eq.0) then
702            WRITE(numout,*) &
703            &   ' detritus remineralisation is *temperature-independent*     jmd         = ', jmd
704         endif
705         if (jsfd.eq.1) then
706            WRITE(numout,*) &
707            &   ' detritus seafloor remineralisation is *accelerated*        jsfd        = ', jsfd
708         else
709            WRITE(numout,*) &
710            &   ' detritus seafloor remineralisation occurs at same rate     jsfd        = ', jsfd
711         endif
712         WRITE(numout,*)     &
713         &   ' detrital nitrogen remineralisation rate,                   xmd         = ', xmd
714         WRITE(numout,*)     &
715         &   ' detrital carbon remineralisation rate,                     xmdc        = ', xmdc
716!!
717!! Stochiometric ratios
718         WRITE(numout,*) '=== Stoichiometric ratios'
719         WRITE(numout,*)     &
720         &   ' non-diatom C:N ratio,                                      xthetapn    = ', xthetapn
721         WRITE(numout,*)     &
722         &   ' diatom C:N ratio,                                          xthetapd    = ', xthetapd
723         WRITE(numout,*)     &
724         &   ' microzoo C:N ratio,                                        xthetazmi   = ', xthetazmi
725         WRITE(numout,*)     &
726         &   ' mesozoo C:N ratio,                                         xthetazme   = ', xthetazme
727         WRITE(numout,*)     &
728         &   ' detritus C:N ratio,                                        xthetad     = ', xthetad
729         WRITE(numout,*)     &
730         &   ' phytoplankton Fe:N ratio,                                  xrfn        = ', xrfn
731         WRITE(numout,*)     &
732         &   ' diatom Si:N ratio,                                         xrsn        = ', xrsn
733!!   
734!! Iron parameters
735         WRITE(numout,*) '=== Iron parameters'
736         if (jiron.eq.1) then
737            WRITE(numout,*)     &
738            &   ' Dutkiewicz et al. (2005) iron scavenging                   jiron       = ', jiron
739         elseif (jiron.eq.2) then
740            WRITE(numout,*)     &
741            &   ' Moore et al. (2004) iron scavenging                        jiron       = ', jiron
742         elseif (jiron.eq.3) then
743            WRITE(numout,*)     &
744            &   ' Moore et al. (2008) iron scavenging                        jiron       = ', jiron
745         elseif (jiron.eq.4) then
746            WRITE(numout,*)     &
747            &   ' Galbraith et al. (2010) iron scavenging                    jiron       = ', jiron
748         else
749            WRITE(numout,*)     &
750            &   ' There is **no** iron scavenging                            jiron       = ', jiron
751         endif
752         WRITE(numout,*)     &
753         &   ' iron atomic mass,                                          xfe_mass    = ', xfe_mass
754         WRITE(numout,*)     &
755         &   ' aeolian iron solubility,                                   xfe_sol     = ', xfe_sol
756         WRITE(numout,*)     &
757         &   ' sediment iron input,                                       xfe_sed     = ', xfe_sed
758         WRITE(numout,*)     &
759         &   ' total ligand concentration (umol/m3),                      xLgT        = ', xLgT
760         WRITE(numout,*)     &
761         &   ' dissociation constant for (Fe + L),                        xk_FeL      = ', xk_FeL
762         WRITE(numout,*)     &
763         &   ' scavenging rate for free iron,                             xk_sc_Fe    = ', xk_sc_Fe
764!!
765!! Fast-sinking detritus parameters
766         WRITE(numout,*) '=== Fast-sinking detritus'
767         if (jexport.eq.1) then
768            WRITE(numout,*) &
769            &   ' fast-detritus remin. uses Dunne et al. (2007; ballast)     jexport     = ', jexport
770         elseif (jexport.eq.2) then
771            WRITE(numout,*) &
772            &   ' fast-detritus remin. uses Martin et al. (1987)             jexport     = ', jexport
773         elseif (jexport.eq.2) then
774            WRITE(numout,*) &
775            &   ' fast-detritus remin. uses Henson et al. (2011)             jexport     = ', jexport
776         endif
777         if (jfdfate.eq.1) then
778            WRITE(numout,*) &
779            &   ' fast-detritus reaching seafloor becomes slow-detritus      jfdfate     = ', jfdfate
780         elseif (jfdfate.eq.0) then
781            WRITE(numout,*) &
782            &   ' fast-detritus reaching seafloor instantly remineralised    jfdfate     = ', jfdfate
783         endif
784#if defined key_roam
785         if (jrratio.eq.0) then
786            WRITE(numout,*) &
787            &   ' Dunne et al. (2005) rain ratio submodel                    jrratio     = ', jrratio
788         elseif (jrratio.eq.1) then
789            WRITE(numout,*) &
790            &   ' Ridgwell et al. (2007) rain ratio submodel (surface omega) jrratio     = ', jrratio
791         elseif (jrratio.eq.2) then
792            WRITE(numout,*) &
793            &   ' Ridgwell et al. (2007) rain ratio submodel (3D omega)      jrratio     = ', jrratio
794         endif
795#else         
796         jrratio = 0
797         WRITE(numout,*) &
798         &   ' Dunne et al. (2005) rain ratio submodel                    jrratio     = ', jrratio
799#endif         
800#if defined key_roam
801         if (jocalccd.eq.0) then
802            WRITE(numout,*) &
803            &   ' Default, fixed CCD used                                    jocalccd    = ', jocalccd
804         elseif (jocalccd.eq.1) then
805            WRITE(numout,*) &
806            &   ' Calculated, dynamic CCD used                               jocalccd    = ', jocalccd
807         endif
808#else         
809         jocalccd = 0
810         WRITE(numout,*) &
811         &   ' Default, fixed CCD used                                    jocalccd    = ', jocalccd
812#endif
813         WRITE(numout,*)     &
814         &   ' Ridgwell rain ratio coefficient,                           xridg_r0    = ', xridg_r0
815         WRITE(numout,*)     &
816         &   ' fast-sinking fraction of diatom nat. mort. losses,         xfdfrac1    = ', xfdfrac1
817         WRITE(numout,*)     &
818         &   ' fast-sinking fraction of mesozooplankton mort. losses,     xfdfrac2    = ', xfdfrac2
819         WRITE(numout,*)     &
820         &   ' fast-sinking fraction of diatom silicon grazing losses,    xfdfrac3    = ', xfdfrac3
821         WRITE(numout,*)     &
822         &   ' polar (high latitude) CaCO3 fraction,                      xcaco3a     = ', xcaco3a
823         WRITE(numout,*)     &
824         &   ' equatorial (low latitude) CaCO3 fraction,                  xcaco3b     = ', xcaco3b
825         WRITE(numout,*)     &
826         &   ' organic C mass:mole ratio, C106 H175 O40 N16 P1,           xmassc      = ', xmassc
827         WRITE(numout,*)     &
828         &   ' calcium carbonate mass:mole ratio, CaCO3,                  xmassca     = ', xmassca
829         WRITE(numout,*)     &
830         &   ' biogenic silicon mass:mole ratio, (H2SiO3)n,               xmasssi     = ', xmasssi
831         WRITE(numout,*)     &
832         &   ' calcium carbonate protection ratio,                        xprotca     = ', xprotca
833         WRITE(numout,*)     &
834         &   ' biogenic silicon protection ratio,                         xprotsi     = ', xprotsi
835         WRITE(numout,*)     &
836         &   ' organic C remineralisation length scale,                   xfastc      = ', xfastc
837         WRITE(numout,*)     &
838         &   ' calcium carbonate dissolution length scale,                xfastca     = ', xfastca
839         WRITE(numout,*)     &
840         &   ' biogenic silicon dissolution length scale,                 xfastsi     = ', xfastsi
841!!
842!! Benthos parameters
843         WRITE(numout,*) '=== Benthos parameters'
844         WRITE(numout,*)     &
845         &   ' does   organic detritus go to the benthos?,                jorgben     = ', jorgben
846         WRITE(numout,*)     &
847         &   ' does inorganic detritus go to the benthos?,                jinorgben   = ', jinorgben
848!!
849!! Some checks on parameters related to benthos parameters
850         if (jorgben.eq.1 .and. jsfd.eq.1) then
851            !! slow detritus going to benthos at an accelerated rate
852            WRITE(numout,*) '  === WARNING! ==='
853            WRITE(numout,*) '  jsfd *and* jorgben are active - please check that you wish this'
854            WRITE(numout,*) '  === WARNING! ==='
855         endif
856         if (jorgben.eq.1 .and. jfdfate.eq.1) then
857            !! fast detritus going to benthos but via slow detritus
858            WRITE(numout,*) '  === WARNING! ==='
859            WRITE(numout,*) '  jfdfate *and* jorgben are active - please check that you wish this'
860            WRITE(numout,*) '  === WARNING! ==='
861         endif
862         if (jorgben.eq.0 .and. jinorgben.eq.1) then
863            !! inorganic fast detritus going to benthos but organic fast detritus is not
864            WRITE(numout,*) '  === WARNING! ==='
865            WRITE(numout,*) '  jinorgben is active but jorgben is not - please check that you wish this'
866            WRITE(numout,*) '  === WARNING! ==='
867         endif
868         WRITE(numout,*)     &
869         &   ' organic   nitrogen sediment remineralisation rate,         xsedn       = ', xsedn
870         WRITE(numout,*)     &
871         &   ' organic   iron     sediment remineralisation rate,         xsedfe      = ', xsedfe
872         WRITE(numout,*)     &
873         &   ' inorganic silicon  sediment remineralisation rate,         xsedsi      = ', xsedsi
874         WRITE(numout,*)     &
875         &   ' organic   carbon   sediment remineralisation rate,         xsedc       = ', xsedc
876         WRITE(numout,*)     &
877         &   ' inorganic carbon   sediment remineralisation rate,         xsedca      = ', xsedca
878         WRITE(numout,*)     &
879         &   ' burial rate of seafloor detritus,                          xburial     = ', xburial
880!!
881!! Riverine inputs
882         WRITE(numout,*) '=== Riverine inputs'
883         if (jriver_n.eq.0) then
884            WRITE(numout,*)     &
885            &   ' *no* riverine N input,                                     jriver_n    = ', jriver_n
886         elseif (jriver_n.eq.1) then
887            WRITE(numout,*)     &
888            &   ' riverine N concentrations specified,                       jriver_n    = ', jriver_n
889         elseif (jriver_n.eq.2) then
890            WRITE(numout,*)     &
891            &   ' riverine N inputs specified,                               jriver_n    = ', jriver_n
892         endif
893         if (jriver_si.eq.0) then
894            WRITE(numout,*)     &
895            &   ' *no* riverine Si input,                                    jriver_si   = ', jriver_si
896         elseif (jriver_si.eq.1) then
897            WRITE(numout,*)     &
898            &   ' riverine Si concentrations specified,                      jriver_si   = ', jriver_si
899         elseif (jriver_si.eq.2) then
900            WRITE(numout,*)     &
901            &   ' riverine Si inputs specified,                              jriver_si   = ', jriver_si
902         endif
903         if (jriver_c.eq.0) then
904            WRITE(numout,*)     &
905            &   ' *no* riverine C input,                                     jriver_c    = ', jriver_c
906         elseif (jriver_c.eq.1) then
907            WRITE(numout,*)     &
908            &   ' riverine C concentrations specified,                       jriver_c    = ', jriver_c
909         elseif (jriver_c.eq.2) then
910            WRITE(numout,*)     &
911            &   ' riverine C inputs specified,                               jriver_c    = ', jriver_c
912         endif
913         if (jriver_alk.eq.0) then
914            WRITE(numout,*)     &
915            &   ' *no* riverine alkalinity input,                            jriver_alk  = ', jriver_alk
916         elseif (jriver_alk.eq.1) then
917            WRITE(numout,*)     &
918            &   ' riverine alkalinity concentrations specified,              jriver_alk  = ', jriver_alk
919         elseif (jriver_alk.eq.2) then
920            WRITE(numout,*)     &
921            &   ' riverine alkalinity inputs specified,                      jriver_alk  = ', jriver_alk
922         endif
923         !! AXY (19/07/12): prevent (gross) stupidity on part of user
924         if (jriver_dep.lt.1.or.jriver_dep.ge.jpk) then
925            jriver_dep = 1
926         endif
927         WRITE(numout,*)     &
928         &   ' riverine input applied to down to depth k = ...            jriver_dep  = ', jriver_dep
929!!
930!! Miscellaneous
931         WRITE(numout,*) '=== Miscellaneous'
932         WRITE(numout,*)     &
933         &   ' diatom frustule dissolution rate,                          xsdiss      = ', xsdiss
934!!
935!! Gravitational sinking     
936         WRITE(numout,*) '=== Gravitational sinking'
937         WRITE(numout,*)     &
938         &   ' detritus gravitational sinking rate,                       vsed        = ', vsed
939         WRITE(numout,*)     &
940         &   ' coefficient for Martin et al. (1987) remineralisation,     xhr         = ', xhr
941!!
942!! Non-Medusa parameters
943         WRITE(numout,*) '=== Non-Medusa parameters'
944         WRITE(numout,*)     &
945         &   ' time coeff of POC in sediments,                            sedlam      = ', sedlam
946         WRITE(numout,*)     &
947         &   ' Sediment geol loss for POC,                                sedlostpoc  = ', sedlostpoc
948         WRITE(numout,*)     &
949         &   ' Vert layer for diagnostic of vertical flux,                jpkp        = ', jpkb
950!!
951!! UKESM1 - new diagnostics  !! Jpalm
952         WRITE(numout,*) '=== UKESM1-related parameters'
953         WRITE(numout,*)     &
954         &   ' include DMS diagnostic?,                                   jdms        = ', jdms
955!!
956      ENDIF
957!!
958!! Key depth positions (with thanks to Andrew Coward for bug-fixing this bit)
959      DO jk = 1,jpk
960         !! level thickness
961         fthk  = e3t_1d(jk)
962         !! level depth (top of level)
963         fdep  = gdepw_1d(jk)
964         !! level depth (bottom of level)
965         fdep1 = fdep + fthk
966         !!
967         if (fdep.lt.100.0.AND.fdep1.gt.100.0) then        !  100 m
968            i0100 = jk
969         elseif (fdep.lt.150.0.AND.fdep1.gt.150.0) then    !  150 m (for BASIN)
970            i0150 = jk
971         elseif (fdep.lt.200.0.AND.fdep1.gt.200.0) then    !  200 m
972            i0200 = jk
973         elseif (fdep.lt.500.0.AND.fdep1.gt.500.0) then    !  500 m
974            i0500 = jk
975         elseif (fdep.lt.1000.0.AND.fdep1.gt.1000.0) then  ! 1000 m
976            i1000 = jk
977         elseif (fdep1.lt.1100.0) then                     ! 1100 m (for Moore et al. sedimentary iron)
978            i1100 = jk
979         endif
980      enddo
981      !!
982      IF(lwp) THEN
983          WRITE(numout,*) '=== Position of key depths'
984          WRITE(numout,*)     &
985          &   ' jk position of  100 m horizon                              i0100       = ', i0100
986          WRITE(numout,*)     &
987          &   ' jk position of  150 m horizon                              i0150       = ', i0150
988          WRITE(numout,*)     &
989          &   ' jk position of  200 m horizon                              i0200       = ', i0200
990          WRITE(numout,*)     &
991          &   ' jk position of  500 m horizon                              i0500       = ', i0500
992          WRITE(numout,*)     &
993          &   ' jk position of 1000 m horizon                              i1000       = ', i1000
994          WRITE(numout,*)     &
995          &   ' jk position of 1100 m horizon [*]                          i1100       = ', i1100
996          WRITE(numout,*) 'Got here ' , SIZE(friver_dep)
997          CALL flush(numout)
998      ENDIF
999
1000#if defined key_roam
1001
1002      ! 1.4b namelist natroam : ROAM parameters
1003      ! ---------------------------------------
1004     
1005      xthetaphy = 0.
1006      xthetazoo = 0.
1007      xthetanit = 0.
1008      xthetarem = 0.
1009      xo2min    = 0.
1010
1011      READ(numnatm,natroam)
1012
1013!! ROAM carbon, alkalinity and oxygen cycle parameters
1014!!       xthetaphy :  oxygen evolution/consumption by phytoplankton
1015!!       xthetazoo :  oxygen consumption by zooplankton
1016!!       xthetanit :  oxygen consumption by nitrogen remineralisation
1017!!       xthetarem :  oxygen consumption by carbon remineralisation
1018!!       xo2min    :  oxygen minimum concentration
1019
1020      IF(lwp) THEN
1021          WRITE(numout,*) 'natroam'
1022          WRITE(numout,*) ' '
1023!!
1024!! ROAM carbon, alkalinity and oxygen cycle parameters
1025          WRITE(numout,*) '=== ROAM carbon, alkalinity and oxygen cycle parameters'
1026          WRITE(numout,*)     &
1027          &   ' oxygen evolution/consumption by phytoplankton              xthetaphy   = ', xthetaphy
1028          WRITE(numout,*)     &
1029          &   ' oxygen consumption by zooplankton                          xthetazoo   = ', xthetazoo
1030          WRITE(numout,*)     &
1031          &   ' oxygen consumption by nitrogen remineralisation            xthetanit   = ', xthetanit
1032          WRITE(numout,*)     &
1033          &   ' oxygen consumption by carbon remineralisation              xthetarem   = ', xthetarem
1034          WRITE(numout,*)     &
1035          &   ' oxygen minimum concentration                               xo2min      = ', xo2min
1036       ENDIF
1037
1038#endif
1039
1040      CALL flush(numout)
1041
1042      ! 1.5 namelist natopt : parameters for optic
1043      ! ------------------------------------------
1044
1045      xkg0  = 0.
1046      xkr0  = 0.
1047      xkgp  = 0.
1048      xkrp  = 0.
1049      xlg   = 0.
1050      xlr   = 0.
1051      rpig  = 0.
1052
1053      READ(numnatm,natopt)
1054
1055      IF(lwp) THEN
1056         WRITE(numout,*) 'natopt'
1057         WRITE(numout,*) ' '
1058         WRITE(numout,*) ' green   water absorption coeff  xkg0  = ',xkg0
1059         WRITE(numout,*) ' red water absorption coeff      xkr0  = ',xkr0
1060         WRITE(numout,*) ' pigment red absorption coeff    xkrp  = ',xkrp
1061         WRITE(numout,*) ' pigment green absorption coeff  xkgp  = ',xkgp
1062         WRITE(numout,*) ' green chl exposant              xlg   = ',xlg
1063         WRITE(numout,*) ' red   chl exposant              xlr   = ',xlr
1064         WRITE(numout,*) ' chla/chla+phea ratio            rpig  = ',rpig
1065         WRITE(numout,*) ' '
1066
1067      ENDIF
1068
1069      IF(lwp) THEN
1070         WRITE(numout,*) 'NaN check'
1071         WRITE(numout,*) ' '
1072         q1 = -1.
1073         q2 = 0.
1074         q3 = log(q1)
1075         write (numout,*) 'q3 = ', q3
1076         if ( ieee_is_nan( q3 ) ) then
1077            write (numout,*) 'NaN detected'
1078         else
1079            write (numout,*) 'NaN not detected'
1080         endif
1081         WRITE(numout,*) ' '
1082       ENDIF
1083
1084   END SUBROUTINE trc_nam_medusa
1085   
1086#else
1087   !!----------------------------------------------------------------------
1088   !!  Dummy module :                                             No MEDUSA
1089   !!----------------------------------------------------------------------
1090CONTAINS
1091   SUBROUTINE trc_nam_medusa                      ! Empty routine
1092   END  SUBROUTINE  trc_nam_medusa
1093#endif 
1094
1095   !!======================================================================
1096END MODULE trcnam_medusa
Note: See TracBrowser for help on using the repository browser.