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.
Changeset 763 for branches/dev_001_GM/NEMO/TOP_SRC/SMS/trclsm.pisces.h90 – NEMO

Ignore:
Timestamp:
2007-12-13T14:52:50+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - Style only addition in TOP F90 h90 routines

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trclsm.pisces.h90

    r730 r763  
    1 !!---------------------------------------------------------------------- 
    2 !!                    ***  trclsm.pisces.h90 *** 
    3 !!---------------------------------------------------------------------- 
     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   !!---------------------------------------------------------------------- 
     9 
     10   !!---------------------------------------------------------------------- 
     11   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     12   !! $Id $  
     13   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     14   !!---------------------------------------------------------------------- 
     15 
    416CONTAINS 
    517 
    618   SUBROUTINE trc_lsm 
    719      !!---------------------------------------------------------------------- 
     20      !!                     ***  trc_lsm  ***   
    821      !! 
    9       !!                       trclsm.pisces.h 
    10       !!                       **************** 
     22      !! ** Purpose :   read PISCES namelist 
    1123      !! 
    12       !!  PURPOSE : 
    13       !!  --------- 
    14       !!     READs and PRINT options for PISCES namelist 
     24      !! ** input   :   file 'namelist.trc.sms' containing the following 
     25      !!             namelist: natext, natbio, natsms 
     26      !!                       natkriest ("key_trc_kriest") 
     27      !!---------------------------------------------------------------------- 
     28      CHARACTER (len=32) ::   clname 
    1529      !! 
    16       !!   MODIFICATIONS: 
    17       !!   -------------- 
    18       !!      original  : 99-10 (M.A. Foujols, M. Levy) passive tracer 
    19       !!      addition  : 00-01 (L. Bopp) hamocc3,p3zd 
    20       !!      
    21       !!---------------------------------------------------------------------- 
    22       !!---------------------------------------------------------------------- 
    23       !! local declarations 
    24       !! ================== 
    25       CHARACTER (len=32) clname 
    26  
    27       !!--------------------------------------------------------------------- 
    28       !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    29    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trclsm.pisces.h90,v 1.7 2007/10/17 14:50:13 opalod Exp $  
    30    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    31       !!--------------------------------------------------------------------- 
    32  
    33       ! 0. initializations 
    34       ! ------------------ 
    35       ! 
    3630      NAMELIST/natext/ atcco2 
    37       NAMELIST/natbio/caco3r, kdca, nca, part,                       & 
    38          &          dispo0,conc0,oxymin,grosip, nrdttrc,              & 
    39          &          pislope, excret,wsbio,wchl,wchld,resrat,mprat,mzrat,   & 
    40          &          grazrat,xprefc,xprefp,unass,xkgraz,xkmort,xksi1, & 
    41          &          xksi2,xremip,xremik,xsirem,xkdoc1,xkdoc2, & 
    42          &          excret2,resrat2,mprat2,mpratm,mzrat2,grazrat2,   & 
    43          &          xprefz,xprefpoc,unass2,xkgraz2,xlam1,      & 
    44          &          ferat3,conc1,conc2,conc3,concnnh4,concdnh4,      & 
    45          &          nitrif,epsher,epsher2,pislope2,wsbio2,sigma1,    & 
    46          &          sigma2, zprefc, zprefp, zprefd,fecnm,fecdm,      & 
    47          &          chlcnm,chlcdm, sedfeinput 
     31      NAMELIST/natbio/ caco3r, kdca, nca, part,                               & 
     32         &             dispo0,conc0,oxymin,grosip, nrdttrc,                   & 
     33         &             pislope, excret,wsbio,wchl,wchld,resrat,mprat,mzrat,   & 
     34         &             grazrat,xprefc,xprefp,unass,xkgraz,xkmort,xksi1,      & 
     35         &             xksi2,xremip,xremik,xsirem,xkdoc1,xkdoc2,              & 
     36         &             excret2,resrat2,mprat2,mpratm,mzrat2,grazrat2,         & 
     37         &             xprefz, xprefpoc, unass2, xkgraz2, xlam1,              & 
     38         &             ferat3,conc1,conc2,conc3,concnnh4,concdnh4,            & 
     39         &             nitrif,epsher,epsher2,pislope2,wsbio2,sigma1,          & 
     40         &             sigma2, zprefc, zprefp, zprefd,fecnm,fecdm,            & 
     41         &             chlcnm,chlcdm, sedfeinput 
    4842      NAMELIST/natsms/bdustfer, briver, bndepo, bsedinput 
    4943#if defined key_trc_kriest 
    50       NAMELIST/natkriest/xkr_eta,xkr_zeta,xkr_sfact,xkr_mass_min,xkr_mass_max,& 
    51          &               xkr_dnano,xkr_ddiat,xkr_dmeso,xkr_daggr,xkr_stick 
     44      NAMELIST/natkriest/ xkr_eta  , xkr_zeta , xkr_sfact, xkr_mass_min, xkr_mass_max,   & 
     45         &                xkr_dnano, xkr_ddiat, xkr_dmeso, xkr_daggr   , xkr_stick 
    5246#endif 
    53  
    54       ! initialize the number of LOGICAL UNIT used 
    55       ! ------------------------------------------ 
    56  
    57       IF(lwp) THEN 
    58          WRITE(numout,*) ' ' 
    59          WRITE(numout,*) ' ROUTINE trclec' 
    60          WRITE(numout,*) ' **************' 
    61          WRITE(numout,*) ' ' 
    62          WRITE(numout,*) ' namelist for PISCES model' 
    63          WRITE(numout,*) ' ***********************' 
    64          WRITE(numout,*) ' ' 
    65       ENDIF 
    66  
     47      !!---------------------------------------------------------------------- 
     48 
     49 
     50      IF(lwp) WRITE(numout,*) 
     51      IF(lwp) WRITE(numout,*) ' trc_lsm : read PISCES namelists' 
     52      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     53 
     54 
     55      !                               ! Open the namelist file 
     56      !                               ! ---------------------- 
    6757      clname ='namelist.trc.sms' 
    6858      CALL ctlopn( numnat, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    6959         &           1, numout, .FALSE., 1 ) 
    7060 
    71       ! 1 Namelist natext : 
    72       ! ------------------- 
    73       READ(numnat,natext) 
    74  
     61      !                               ! natext : Atmospheric parameters 
     62      !                               ! -------------------- ---------- 
     63      REWIND( numnat )                     ! read natext 
     64      READ  ( numnat, natext ) 
     65 
     66      IF(lwp) THEN                         ! control print 
     67         WRITE(numout,*) 
     68         WRITE(numout,*) ' Namelist : natext' 
     69         WRITE(numout,*) '    atmospheric pCO2                         atcco2 = ',atcco2 
     70      ENDIF 
     71 
     72 
     73      !                               ! natbio : biological parameters 
     74      !                               ! ------------------------------ 
     75      REWIND( numnat )                     ! read natbio 
     76      READ  ( numnat, natbio ) 
     77 
     78      IF(lwp) THEN                         ! control print 
     79         WRITE(numout,*) ' Namelist : natbio' 
     80         WRITE(numout,*) '    mean rainratio                            caco3r    =', caco3r 
     81         WRITE(numout,*) '    diss. rate constant calcite (per month)   kdca      =', kdca 
     82         WRITE(numout,*) '    order of reaction for calcite dissolution nca       =', nca 
     83         WRITE(numout,*) '    part of calcite not dissolved in guts     part      =', part 
     84         WRITE(numout,*) '    mean Si/C ratio                           grosip    =', grosip 
     85         WRITE(numout,*) '    Calcite dissolution half saturation       dispo0    =', dispo0 
     86         WRITE(numout,*) '    Phosphate half saturation                 conc0     =', conc0 
     87         WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc 
     88         WRITE(numout,*) '    P-I slope                                 pislope   =', pislope 
     89         WRITE(numout,*) '    excretion ratio of phytoplankton          excret    =', excret 
     90         WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio 
     91         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl 
     92         WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchld     =', wchld 
     93         WRITE(numout,*) '    exsudation rate of zooplankton            resrat    =', resrat 
     94         WRITE(numout,*) '    phytoplankton mortality rate              mprat     =', mprat 
     95         WRITE(numout,*) '    zooplankton mortality rate                mzrat     =', mzrat 
     96         WRITE(numout,*) '    zoo preference for phyto                  xprefc    =', xprefc 
     97         WRITE(numout,*) '    zoo preference for POC                    xprefp    =', xprefp 
     98         WRITE(numout,*) '    maximal zoo grazing rate                  grazrat   =', grazrat 
     99         WRITE(numout,*) '    non assimilated fraction of phyto by zoo  unass     =', unass 
     100         WRITE(numout,*) '    half sturation constant for grazing       xkgraz    =', xkgraz 
     101         WRITE(numout,*) '    half saturation constant for mortality    xkmort    =', xkmort 
     102         WRITE(numout,*) '    half saturation constant for Si uptake    xksi1     =', xksi1 
     103         WRITE(numout,*) '    half saturation constant for Si/C         xksi2     =', xksi2 
     104         WRITE(numout,*) '    remineralisation rate of POC              xremip    =', xremip 
     105         WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik 
     106         WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem  
     107         WRITE(numout,*) '    1st half-sat. of DOC remineralization     xkdoc1    =', xkdoc1 
     108         WRITE(numout,*) '    2nd half-sat. of DOC remineralization     xkdoc2    =', xkdoc2 
     109         WRITE(numout,*) '    excretion ratio of diatoms                excret2   =', excret2 
     110         WRITE(numout,*) '    exsudation rate of mesozooplankton        resrat2   =', resrat2 
     111         WRITE(numout,*) '    Diatoms mortality rate                    mprat2    =', mprat2 
     112         WRITE(numout,*) '    Phytoplankton minimum mortality rate      mpratm    =', mpratm 
     113         WRITE(numout,*) '    mesozooplankton mortality rate            mzrat2    =', mzrat2 
     114         WRITE(numout,*) '    zoo preference for zoo                    xprefz    =', xprefz 
     115         WRITE(numout,*) '    zoo preference for poc                    xprefpoc  =', xprefpoc 
     116         WRITE(numout,*) '    maximal mesozoo grazing rate              grazrat2  =', grazrat2 
     117         WRITE(numout,*) '    non assimilated fraction of P by mesozoo  unass2    =', unass2 
     118         WRITE(numout,*) '    Efficicency of Mesozoo growth             epsher2   =', epsher2  
     119         WRITE(numout,*) '    Efficiency of microzoo growth             epsher    =', epsher 
     120         WRITE(numout,*) '    half sturation constant for grazing 2     xkgraz2   =', xkgraz2 
     121         WRITE(numout,*) '    Maximum aggregation rate for diatoms      wchld     =', wchld 
     122         WRITE(numout,*) '    scavenging rate of Iron                   xlam1     =', xlam1 
     123         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3 
     124         WRITE(numout,*) '    Phosphate half saturation for diatoms     conc1     =', conc1 
     125         WRITE(numout,*) '    Iron half saturation for phyto            conc2     =', conc2 
     126         WRITE(numout,*) '    Iron half saturation for diatoms          conc3     =', conc3 
     127         WRITE(numout,*) '    NH4 half saturation for phyto             concnnh4  =', concnnh4 
     128         WRITE(numout,*) '    NH4 half saturation for diatoms           concdnh4  =', concdnh4 
     129         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif 
     130         WRITE(numout,*) '    P-I slope  for diatoms                    pislope2  =', pislope2 
     131         WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2 
     132         WRITE(numout,*) '    Fraction of microzoo excretion as DOM     sigma1    =', sigma1 
     133         WRITE(numout,*) '    Fraction of mesozoo excretion as DOM      sigma2    =', sigma2 
     134         WRITE(numout,*) '    Microzoo preference for POM               zprefc    =', zprefc 
     135         WRITE(numout,*) '    Microzoo preference for Nanophyto         zprefp    =', zprefp 
     136         WRITE(numout,*) '    Microzoo preference for Diatoms           zprefd    =', zprefd 
     137         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm    =', chlcnm 
     138         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm    =', chlcdm 
     139         WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm     =', fecnm 
     140         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm 
     141         WRITE(numout,*) '    Coastal release of Iron                   sedfeinput=', sedfeinput 
     142      ENDIF 
     143 
     144      !                               ! natsms : SMS parameters 
     145      !                               ! ----------------------- 
     146      REWIND( numnat )                     ! read natsms 
     147      READ  ( numnat, natsms ) 
    75148      IF(lwp) THEN 
    76149         WRITE(numout,*) ' ' 
    77          WRITE(numout,*) 'natext' 
    78          WRITE(numout,*) ' ' 
    79          WRITE(numout,*) 'atmospheric pCO2= ',atcco2 
    80          WRITE(numout,*) ' ' 
     150         WRITE(numout,*) ' Namelist : natsms' 
     151         WRITE(numout,*) '    Dust input from the atmosphere           bdustfer  = ', bdustfer 
     152         WRITE(numout,*) '    River input of nutrients                 briver    = ', briver 
     153         WRITE(numout,*) '    Atmospheric deposition of N              bndepo    = ', bndepo 
     154         WRITE(numout,*) '    Fe input from sediments                  bsedinput = ', bsedinput 
    81155      ENDIF 
    82156 
    83  
    84       READ(numnat,natbio) 
     157#if defined key_trc_kriest 
     158 
     159      !                               ! natkriest : kriest parameters 
     160      !                               ! ----------------------------- 
     161      REWIND( numnat )                     ! read natkriest 
     162      READ  ( numnat, natkriest ) 
     163 
    85164      IF(lwp) THEN 
    86          WRITE(numout,*) 'natbio' 
    87          WRITE(numout,*) ' ' 
    88          WRITE(numout,*)      & 
    89             &   ' mean rainratio                             =', caco3r 
    90          WRITE(numout,*)      & 
    91             &   ' diss. rate constant calcite (per month)    =', kdca 
    92          WRITE(numout,*)      & 
    93             &   ' order of reaction for calcite dissolution  =', nca 
    94          WRITE(numout,*)      & 
    95             &   ' part of calcite not dissolved in guts      =', part 
    96          WRITE(numout,*)      & 
    97             &   ' mean Si/C ratio                            =', grosip 
    98          WRITE(numout,*)      & 
    99             &   ' Calcite dissolution half saturation        =', dispo0 
    100          WRITE(numout,*)      & 
    101             &   ' Phosphate half saturation                  =', conc0 
    102          WRITE(numout,*)      & 
    103             &   ' frequence pour la biologie                 =', nrdttrc 
    104          WRITE(numout,*)      & 
    105             &   ' P-I slope                                  =', pislope 
    106          WRITE(numout,*)      & 
    107             &   ' excretion ratio of phytoplankton           =', excret 
    108          WRITE(numout,*)      & 
    109             &   ' POC sinking speed                          =', wsbio 
    110          WRITE(numout,*)      & 
    111             &   ' quadratic mortality of phytoplankton       =', wchl 
    112          WRITE(numout,*)      & 
    113             &   ' maximum quadratic mortality of diatoms     =', wchld 
    114          WRITE(numout,*)      & 
    115             &   ' exsudation rate of zooplankton             =', resrat 
    116          WRITE(numout,*)      & 
    117             &   ' phytoplankton mortality rate               =', mprat 
    118          WRITE(numout,*)      & 
    119             &   ' zooplankton mortality rate                 =', mzrat 
    120          WRITE(numout,*)      & 
    121             &   ' zoo preference for phyto                   =', xprefc 
    122          WRITE(numout,*)      & 
    123             &   ' zoo preference for POC                     =', xprefp 
    124          WRITE(numout,*)      & 
    125             &   ' maximal zoo grazing rate                   =', grazrat 
    126          WRITE(numout,*)      & 
    127             &   ' non assimilated fraction of phyto by zoo   =', unass 
    128          WRITE(numout,*)      & 
    129             &   ' half sturation constant for grazing        =', xkgraz 
    130          WRITE(numout,*)      & 
    131             &   ' half saturation constant for mortality     =', xkmort 
    132          WRITE(numout,*)      & 
    133             &   ' half saturation constant for Si uptake     =', xksi1 
    134          WRITE(numout,*)      & 
    135             &   ' half saturation constant for Si/C          =', xksi2 
    136          WRITE(numout,*)      & 
    137             &   ' remineralisation rate of POC               =', xremip 
    138          WRITE(numout,*)      & 
    139             &   ' remineralization rate of DOC               =', xremik 
    140          WRITE(numout,*)      &  
    141             &   ' remineralization rate of Si                =', xsirem  
    142          WRITE(numout,*)      & 
    143             &   ' 1st half-sat. of DOC remineralization      =', xkdoc1 
    144          WRITE(numout,*)      & 
    145             &   ' 2nd half-sat. of DOC remineralization      =', xkdoc2 
    146          WRITE(numout,*)      & 
    147             &   ' excretion ratio of diatoms                 =', excret2 
    148          WRITE(numout,*)      & 
    149             &   ' exsudation rate of mesozooplankton         =', resrat2 
    150          WRITE(numout,*)      & 
    151             &   ' Diatoms mortality rate                     =', mprat2 
    152          WRITE(numout,*)      & 
    153             &   ' Phytoplankton minimum mortality rate       =', mpratm 
    154          WRITE(numout,*)      & 
    155             &   ' mesozooplankton mortality rate             =', mzrat2 
    156          WRITE(numout,*)      & 
    157             &   ' zoo preference for zoo                     =', xprefz 
    158          WRITE(numout,*)      & 
    159             &   ' zoo preference for poc                   =', xprefpoc 
    160          WRITE(numout,*)      & 
    161             &   ' maximal mesozoo grazing rate               =', grazrat2 
    162          WRITE(numout,*)      & 
    163             &   ' non assimilated fraction of P by mesozoo   =', unass2 
    164          WRITE(numout,*)      & 
    165             &   ' Efficicency of Mesozoo growth              =', epsher2  
    166          WRITE(numout,*)      & 
    167             &   ' Efficiency of microzoo growth              =', epsher 
    168          WRITE(numout,*)      & 
    169             &   ' half sturation constant for grazing 2      =', xkgraz2 
    170          WRITE(numout,*)      & 
    171             &   ' Maximum aggregation rate for diatoms       =', wchld 
    172          WRITE(numout,*)      & 
    173             &   ' scavenging rate of Iron                    =', xlam1 
    174          WRITE(numout,*)      & 
    175             &   ' Fe/C in zooplankton                        =', ferat3 
    176          WRITE(numout,*)      & 
    177             &   ' Phosphate half saturation for diatoms      =', conc1 
    178          WRITE(numout,*)      & 
    179             &   ' Iron half saturation for phyto             =', conc2 
    180          WRITE(numout,*)      & 
    181             &   ' Iron half saturation for diatoms           =', conc3 
    182          WRITE(numout,*)      & 
    183             &   ' NH4 half saturation for phyto              =', concnnh4 
    184          WRITE(numout,*)      & 
    185             &   ' NH4 half saturation for diatoms            =', concdnh4 
    186          WRITE(numout,*)      & 
    187             &   ' NH4 nitrification rate                     =', nitrif 
    188          WRITE(numout,*)      & 
    189             &   ' P-I slope  for diatoms                     =', pislope2 
    190          WRITE(numout,*)      & 
    191             &   ' Big particles sinking speed                =', wsbio2 
    192          WRITE(numout,*)      & 
    193             &   ' Fraction of microzoo excretion as DOM      =', sigma1 
    194          WRITE(numout,*)      & 
    195             &   ' Fraction of mesozoo excretion as DOM       =', sigma2 
    196          WRITE(numout,*)      & 
    197             &   ' Microzoo preference for POM                =', zprefc 
    198          WRITE(numout,*)      & 
    199             &   ' Microzoo preference for Nanophyto          =', zprefp 
    200          WRITE(numout,*)      & 
    201             &   ' Microzoo preference for Diatoms          =', zprefd 
    202          WRITE(numout,*)      & 
    203             &   ' Minimum Chl/C in nanophytoplankton         =', chlcnm 
    204          WRITE(numout,*)      & 
    205             &   ' Minimum Chl/C in diatoms                   =', chlcdm 
    206          WRITE(numout,*)      & 
    207             &   ' Maximum Fe/C in nanophytoplankton          =', fecnm 
    208          WRITE(numout,*)      & 
    209             &   ' Minimum Fe/C in diatoms                    =', fecdm 
    210          WRITE(numout,*)      & 
    211             &   ' Coastal release of Iron                 =', sedfeinput 
    212       ENDIF 
    213  
    214       READ(numnat,natsms) 
    215       IF(lwp) THEN 
    216          WRITE(numout,*) ' ' 
    217          WRITE(numout,*) 'natsms' 
    218          WRITE(numout,*) ' ' 
    219          WRITE(numout,*) 'Dust input from the atmosphere : ', bdustfer 
    220          WRITE(numout,*) ' ' 
    221          WRITE(numout,*) 'River input of nutrients : ', briver 
    222          WRITE(numout,*) ' ' 
    223          WRITE(numout,*) 'Atmospheric deposition of N : ', bndepo 
    224          WRITE(numout,*) ' ' 
    225          WRITE(numout,*) 'Fe input from sediments : ', bsedinput 
    226          WRITE(numout,*) ' ' 
    227       ENDIF 
    228  
    229 #if defined key_trc_kriest 
    230  
    231       READ(numnat,natkriest) 
    232       IF(lwp) THEN 
    233          WRITE(numout,*) ' ' 
    234          WRITE(numout,*) 'natkriest' 
    235          WRITE(numout,*) ' ' 
    236          WRITE(numout,*) 'Sinking  exponent                    xkr_eta       = ', xkr_eta  
    237          WRITE(numout,*) 'N content exponent                   xkr_zeta      = ', xkr_zeta 
    238          WRITE(numout,*) 'Sinking factor                       xkr_sfact     = ', xkr_sfact 
    239          WRITE(numout,*) 'Stickiness                           xkr_stick     = ', xkr_stick 
    240          WRITE(numout,*) 'Minimum mass for Aggregates          xkr_mass_min  = ', xkr_mass_min 
    241          WRITE(numout,*) 'Maximum mass for Aggregates          xkr_mass_max  = ', xkr_mass_max 
    242          WRITE(numout,*) 'Size of particles in nano pool       xkr_dnano     = ', xkr_dnano 
    243          WRITE(numout,*) 'Size of particles in diatoms pool    xkr_ddiat     = ', xkr_ddiat 
    244          WRITE(numout,*) 'Size of particles in mesozoo pool    xkr_dmeso     = ', xkr_dmeso 
    245          WRITE(numout,*) 'Size of particles in aggregates pool xkr_daggr     = ', xkr_daggr 
     165         WRITE(numout,*) 
     166         WRITE(numout,*) ' Namelist : natkriest' 
     167         WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta  
     168         WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta 
     169         WRITE(numout,*) '    Sinking factor                           xkr_sfact    = ', xkr_sfact 
     170         WRITE(numout,*) '    Stickiness                               xkr_stick    = ', xkr_stick 
     171         WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min 
     172         WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max 
     173         WRITE(numout,*) '    Size of particles in nano pool           xkr_dnano    = ', xkr_dnano 
     174         WRITE(numout,*) '    Size of particles in diatoms pool        xkr_ddiat    = ', xkr_ddiat 
     175         WRITE(numout,*) '    Size of particles in mesozoo pool        xkr_dmeso    = ', xkr_dmeso 
     176         WRITE(numout,*) '    Size of particles in aggregates pool     xkr_daggr    = ', xkr_daggr 
    246177     ENDIF 
    247178 
    248179 
    249180     ! Computation of some variables 
    250      xkr_massp     = 5.7E-6 * 7.6 * xkr_mass_min**xkr_zeta 
     181     xkr_massp = 5.7E-6 * 7.6 * xkr_mass_min**xkr_zeta 
     182      
    251183     ! max and min vertical particle speed 
    252184     xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta 
    253185     xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta 
    254      WRITE(numout,*) ' max and min vertical particle speed ',xkr_wsbio_min,xkr_wsbio_max 
     186     WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max 
     187      
    255188     ! 
    256189     !    effect of the sizes of the different living pools on particle numbers 
     
    267200     xkr_naggr = 1. / ( xkr_massp * xkr_daggr ) 
    268201     
    269  
    270202#endif 
    271  
     203      ! 
    272204   END SUBROUTINE trc_lsm 
Note: See TracChangeset for help on using the changeset viewer.