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.
trclsm_pisces.F90 in branches/dev_001_GM/NEMO/TOP_SRC/PISCES – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90 @ 772

Last change on this file since 772 was 772, checked in by gm, 16 years ago

dev_001_GM - change the name of cpp key to key_top, key_lobster, key_pisces, key_kriest and the corresponding lk_

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 13.6 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                     ***  trclsm.pisces.h90  *** 
3   !! TOP :   Definition some run parameter for PISCES biological model
4   !!----------------------------------------------------------------------
5   !! History :    -   !  1999-10 (M.A. Foujols, M. Levy) original code
6   !!              -   !  2000-01 (L. Bopp) hamocc3, p3zd
7   !!             1.0  !  2003-08 (C. Ethe)  module F90
8   !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trclsm.pisces.h90
9   !!----------------------------------------------------------------------
10#if defined key_pisces
11   !!----------------------------------------------------------------------
12   !!   'key_pisces'   :                                   PISCES bio-model
13   !!----------------------------------------------------------------------
14   !! trc_lsm_pisces       : PISCES model namelist read
15   !!----------------------------------------------------------------------
16   USE oce_trc         ! Ocean variables
17   USE par_trc         ! TOP parameters
18   USE trc             ! TOP variables
19   USE sms             ! sms trends
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   trc_lsm_pisces   ! called by trclsm.F90 module
25
26   !!----------------------------------------------------------------------
27   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
28   !! $Id$
29   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
30   !!----------------------------------------------------------------------
31
32CONTAINS
33
34   SUBROUTINE trc_lsm_pisces
35      !!----------------------------------------------------------------------
36      !!                     ***  trc_lsm_pisces  *** 
37      !!
38      !! ** Purpose :   read PISCES namelist
39      !!
40      !! ** input   :   file 'namelist.trc.sms' containing the following
41      !!             namelist: natext, natbio, natsms
42      !!                       natkriest ("key_kriest")
43      !!----------------------------------------------------------------------
44      CHARACTER (len=32) ::   clname
45      !!
46      NAMELIST/natext/ atcco2
47      NAMELIST/natbio/ caco3r, kdca, nca, part,                               &
48         &             dispo0,conc0,oxymin,grosip, nrdttrc,                   &
49         &             pislope, excret,wsbio,wchl,wchld,resrat,mprat,mzrat,   &
50         &             grazrat,xprefc,xprefp,unass,xkgraz,xkmort,xksi1,       &
51         &             xksi2,xremip,xremik,xsirem,xkdoc1,xkdoc2,              &
52         &             excret2,resrat2,mprat2,mpratm,mzrat2,grazrat2,         &
53         &             xprefz, xprefpoc, unass2, xkgraz2, xlam1,              &
54         &             ferat3,conc1,conc2,conc3,concnnh4,concdnh4,            &
55         &             nitrif,epsher,epsher2,pislope2,wsbio2,sigma1,          &
56         &             sigma2, zprefc, zprefp, zprefd,fecnm,fecdm,            &
57         &             chlcnm,chlcdm, sedfeinput
58      NAMELIST/natsms/bdustfer, briver, bndepo, bsedinput
59#if defined key_kriest
60      NAMELIST/natkriest/ xkr_eta  , xkr_zeta , xkr_sfact, xkr_mass_min, xkr_mass_max,   &
61         &                xkr_dnano, xkr_ddiat, xkr_dmeso, xkr_daggr   , xkr_stick
62#endif
63      !!----------------------------------------------------------------------
64
65      IF(lwp) WRITE(numout,*)
66      IF(lwp) WRITE(numout,*) ' trc_lsm_pisces : read PISCES namelists'
67      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
68
69
70      !                               ! Open the namelist file
71      !                               ! ----------------------
72      clname ='namelist.trc.sms'
73      CALL ctlopn( numnat, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   &
74         &           1, numout, .FALSE., 1 )
75
76      !                               ! natext : Atmospheric parameters
77      !                               ! -------------------- ----------
78      REWIND( numnat )                     ! read natext
79      READ  ( numnat, natext )
80
81      IF(lwp) THEN                         ! control print
82         WRITE(numout,*)
83         WRITE(numout,*) ' Namelist : natext'
84         WRITE(numout,*) '    atmospheric pCO2                         atcco2 = ',atcco2
85      ENDIF
86
87
88      !                               ! natbio : biological parameters
89      !                               ! ------------------------------
90      REWIND( numnat )                     ! read natbio
91      READ  ( numnat, natbio )
92
93      IF(lwp) THEN                         ! control print
94         WRITE(numout,*) ' Namelist : natbio'
95         WRITE(numout,*) '    mean rainratio                            caco3r    =', caco3r
96         WRITE(numout,*) '    diss. rate constant calcite (per month)   kdca      =', kdca
97         WRITE(numout,*) '    order of reaction for calcite dissolution nca       =', nca
98         WRITE(numout,*) '    part of calcite not dissolved in guts     part      =', part
99         WRITE(numout,*) '    mean Si/C ratio                           grosip    =', grosip
100         WRITE(numout,*) '    Calcite dissolution half saturation       dispo0    =', dispo0
101         WRITE(numout,*) '    Phosphate half saturation                 conc0     =', conc0
102         WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc
103         WRITE(numout,*) '    P-I slope                                 pislope   =', pislope
104         WRITE(numout,*) '    excretion ratio of phytoplankton          excret    =', excret
105         WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio
106         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl
107         WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchld     =', wchld
108         WRITE(numout,*) '    exsudation rate of zooplankton            resrat    =', resrat
109         WRITE(numout,*) '    phytoplankton mortality rate              mprat     =', mprat
110         WRITE(numout,*) '    zooplankton mortality rate                mzrat     =', mzrat
111         WRITE(numout,*) '    zoo preference for phyto                  xprefc    =', xprefc
112         WRITE(numout,*) '    zoo preference for POC                    xprefp    =', xprefp
113         WRITE(numout,*) '    maximal zoo grazing rate                  grazrat   =', grazrat
114         WRITE(numout,*) '    non assimilated fraction of phyto by zoo  unass     =', unass
115         WRITE(numout,*) '    half sturation constant for grazing       xkgraz    =', xkgraz
116         WRITE(numout,*) '    half saturation constant for mortality    xkmort    =', xkmort
117         WRITE(numout,*) '    half saturation constant for Si uptake    xksi1     =', xksi1
118         WRITE(numout,*) '    half saturation constant for Si/C         xksi2     =', xksi2
119         WRITE(numout,*) '    remineralisation rate of POC              xremip    =', xremip
120         WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik
121         WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem 
122         WRITE(numout,*) '    1st half-sat. of DOC remineralization     xkdoc1    =', xkdoc1
123         WRITE(numout,*) '    2nd half-sat. of DOC remineralization     xkdoc2    =', xkdoc2
124         WRITE(numout,*) '    excretion ratio of diatoms                excret2   =', excret2
125         WRITE(numout,*) '    exsudation rate of mesozooplankton        resrat2   =', resrat2
126         WRITE(numout,*) '    Diatoms mortality rate                    mprat2    =', mprat2
127         WRITE(numout,*) '    Phytoplankton minimum mortality rate      mpratm    =', mpratm
128         WRITE(numout,*) '    mesozooplankton mortality rate            mzrat2    =', mzrat2
129         WRITE(numout,*) '    zoo preference for zoo                    xprefz    =', xprefz
130         WRITE(numout,*) '    zoo preference for poc                    xprefpoc  =', xprefpoc
131         WRITE(numout,*) '    maximal mesozoo grazing rate              grazrat2  =', grazrat2
132         WRITE(numout,*) '    non assimilated fraction of P by mesozoo  unass2    =', unass2
133         WRITE(numout,*) '    Efficicency of Mesozoo growth             epsher2   =', epsher2 
134         WRITE(numout,*) '    Efficiency of microzoo growth             epsher    =', epsher
135         WRITE(numout,*) '    half sturation constant for grazing 2     xkgraz2   =', xkgraz2
136         WRITE(numout,*) '    Maximum aggregation rate for diatoms      wchld     =', wchld
137         WRITE(numout,*) '    scavenging rate of Iron                   xlam1     =', xlam1
138         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3
139         WRITE(numout,*) '    Phosphate half saturation for diatoms     conc1     =', conc1
140         WRITE(numout,*) '    Iron half saturation for phyto            conc2     =', conc2
141         WRITE(numout,*) '    Iron half saturation for diatoms          conc3     =', conc3
142         WRITE(numout,*) '    NH4 half saturation for phyto             concnnh4  =', concnnh4
143         WRITE(numout,*) '    NH4 half saturation for diatoms           concdnh4  =', concdnh4
144         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif
145         WRITE(numout,*) '    P-I slope  for diatoms                    pislope2  =', pislope2
146         WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2
147         WRITE(numout,*) '    Fraction of microzoo excretion as DOM     sigma1    =', sigma1
148         WRITE(numout,*) '    Fraction of mesozoo excretion as DOM      sigma2    =', sigma2
149         WRITE(numout,*) '    Microzoo preference for POM               zprefc    =', zprefc
150         WRITE(numout,*) '    Microzoo preference for Nanophyto         zprefp    =', zprefp
151         WRITE(numout,*) '    Microzoo preference for Diatoms           zprefd    =', zprefd
152         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm    =', chlcnm
153         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm    =', chlcdm
154         WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm     =', fecnm
155         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm
156         WRITE(numout,*) '    Coastal release of Iron                   sedfeinput=', sedfeinput
157      ENDIF
158
159      !                               ! natsms : SMS parameters
160      !                               ! -----------------------
161      REWIND( numnat )                     ! read natsms
162      READ  ( numnat, natsms )
163      IF(lwp) THEN
164         WRITE(numout,*) ' '
165         WRITE(numout,*) ' Namelist : natsms'
166         WRITE(numout,*) '    Dust input from the atmosphere           bdustfer  = ', bdustfer
167         WRITE(numout,*) '    River input of nutrients                 briver    = ', briver
168         WRITE(numout,*) '    Atmospheric deposition of N              bndepo    = ', bndepo
169         WRITE(numout,*) '    Fe input from sediments                  bsedinput = ', bsedinput
170      ENDIF
171
172#if defined key_kriest
173
174      !                               ! natkriest : kriest parameters
175      !                               ! -----------------------------
176      REWIND( numnat )                     ! read natkriest
177      READ  ( numnat, natkriest )
178
179      IF(lwp) THEN
180         WRITE(numout,*)
181         WRITE(numout,*) ' Namelist : natkriest'
182         WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta 
183         WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta
184         WRITE(numout,*) '    Sinking factor                           xkr_sfact    = ', xkr_sfact
185         WRITE(numout,*) '    Stickiness                               xkr_stick    = ', xkr_stick
186         WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min
187         WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max
188         WRITE(numout,*) '    Size of particles in nano pool           xkr_dnano    = ', xkr_dnano
189         WRITE(numout,*) '    Size of particles in diatoms pool        xkr_ddiat    = ', xkr_ddiat
190         WRITE(numout,*) '    Size of particles in mesozoo pool        xkr_dmeso    = ', xkr_dmeso
191         WRITE(numout,*) '    Size of particles in aggregates pool     xkr_daggr    = ', xkr_daggr
192     ENDIF
193
194
195     ! Computation of some variables
196     xkr_massp = 5.7E-6 * 7.6 * xkr_mass_min**xkr_zeta
197     
198     ! max and min vertical particle speed
199     xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta
200     xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta
201     WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max
202     
203     !
204     !    effect of the sizes of the different living pools on particle numbers
205     !    nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337
206     !    diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718
207     !    mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147
208     !    aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877
209     !    doc aggregates = 1um
210     ! ----------------------------------------------------------
211
212     xkr_nnano = 1. / ( xkr_massp * xkr_dnano )
213     xkr_ndiat = 1. / ( xkr_massp * xkr_ddiat )
214     xkr_nmeso = 1. / ( xkr_massp * xkr_dmeso )
215     xkr_naggr = 1. / ( xkr_massp * xkr_daggr )
216   
217#endif
218      !
219   END SUBROUTINE trc_lsm_pisces
220
221#else
222   !!----------------------------------------------------------------------
223   !!  Dummy module :                                   No PISCES bio-model
224   !!----------------------------------------------------------------------
225CONTAINS
226   SUBROUTINE trc_lsm_pisces                      ! Empty routine
227   END  SUBROUTINE  trc_lsm_pisces
228#endif 
229
230   !!======================================================================
231END MODULE trclsm_pisces
Note: See TracBrowser for help on using the repository browser.