MODULE trcnam_medusa !!====================================================================== !! *** MODULE trcnam_medusa *** !! TOP : initialisation of some run parameters for MEDUSA bio-model !!====================================================================== !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) Original code !! - ! 2008-08 (K. Popova) adaptation for MEDUSA !! - ! 2008-11 (A. Yool) continuing adaptation for MEDUSA !! - ! 2010-03 (A. Yool) updated for branch inclusion !! - ! 2011-04 (A. Yool) updated for ROAM project !! - ! 2013-05 (A. Yool) renamed (from trclsm) for v3.5 !!---------------------------------------------------------------------- #if defined key_medusa !!---------------------------------------------------------------------- !! 'key_medusa' : MEDUSA model !!---------------------------------------------------------------------- !! trc_nam_medusa : MEDUSA model initialisation !!---------------------------------------------------------------------- USE oce_trc ! Ocean variables USE par_trc ! TOP parameters USE trc ! TOP variables USE sms_medusa ! sms trends USE iom ! I/O manager !! AXY (04/02/14): necessary to find NaNs on HECTOR USE, INTRINSIC :: ieee_arithmetic IMPLICIT NONE PRIVATE PUBLIC trc_nam_medusa ! called by trcnam.F90 module !!* Substitution # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE trc_nam_medusa !!---------------------------------------------------------------------- !! *** trc_nam_medusa *** !! !! ** Purpose : read MEDUSA namelist !! !! ** input : file 'namelist.trc.sms' containing the following !! namelist: natbio, natopt, and natdbi ("key_trc_diabio") !! !! ekp: namelist nabio contains ALL parameters of the ecosystem !! point sourses and sinks PLUS sediment exchange !! dia_bio - used by Lobster to output all point terms !! (sourses and sinks of bio) !! dia_add - additional diagnostics for biology such as !! primary production (2d depth integrated field or 3d) !!---------------------------------------------------------------------- !! INTEGER :: ji,jj,jk REAL(wp) :: fthk, fdep, fdep1 REAL(wp) :: q1, q2, q3 ! NAMELIST/natbio/ xxi,xaln,xald,jphy,xvpn,xvpd, & & xsin0,xnsi0,xuif,jliebig, & & xthetam,xthetamd,xnln,xnld,xsld,xfln,xfld, & & xgmi,xgme,xkmi,xkme,xphi,xbetan,xbetac,xkc, & & xpmipn,xpmid,xpmepn,xpmepd,xpmezmi,xpmed, & & xmetapn,xmetapd,xmetazmi,xmetazme, & & jmpn,xmpn,xkphn,jmpd,xmpd,xkphd,jmzmi,xmzmi,xkzmi, & & jmzme,xmzme,xkzme,jmd,jsfd,xmd,xmdc, & & xthetapn,xthetapd,xthetazmi,xthetazme,xthetad, & & xrfn,xrsn,vsed,xhr, & & jiron,xfe_mass,xfe_sol,xfe_sed,xLgT,xk_FeL,xk_sc_Fe, & & jexport,jfdfate,jrratio,jocalccd,xridg_r0, & & xfdfrac1,xfdfrac2,xfdfrac3, & & xcaco3a,xcaco3b,xmassc,xmassca,xmasssi,xprotca, & & xprotsi,xfastc,xfastca,xfastsi, & & jorgben,jinorgben,xsedn,xsedfe,xsedsi,xsedc,xsedca, & & xburial, & & jriver_n,jriver_si,jriver_c,jriver_alk,jriver_dep, & & friver_dep, & & xsdiss, & & vsed,xhr, & & sedlam,sedlostpoc,jpkb,jdms #if defined key_roam NAMELIST/natroam/ xthetaphy,xthetazoo,xthetanit, & & xthetarem,xo2min, & & f3_pH,f3_h2co3,f3_hco3,f3_co3,f3_omcal,f3_omarg, & & f2_ccd_cal,f2_ccd_arg #endif NAMELIST/natopt/xkg0,xkr0,xkgp,xkrp,xlg,xlr,rpig INTEGER :: jl, jn INTEGER :: ios ! Local integer output status for namelist read TYPE(DIAG), DIMENSION(jp_medusa_2d) :: meddia2d TYPE(DIAG), DIMENSION(jp_medusa_3d) :: meddia3d TYPE(DIAG), DIMENSION(jp_medusa_trd) :: meddiabio CHARACTER(LEN=32) :: clname !! NAMELIST/nammeddia/ meddia3d, meddia2d ! additional diagnostics !!---------------------------------------------------------------------- IF(lwp) WRITE(numout,*) clname = 'namelist_medusa' IF(lwp) WRITE(numout,*) ' trc_nam_medusa: read MEDUSA namelist' IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' # if defined key_debug_medusa CALL flush(numout) # endif CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) CALL ctl_opn( numnatp_cfg, TRIM( clname )//'_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) IF(lwm) CALL ctl_opn( numonp , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) # if defined key_debug_medusa CALL flush(numout) IF (lwp) write (numout,*) '------------------------------' IF (lwp) write (numout,*) 'Jpalm - debug' IF (lwp) write (numout,*) 'open namelist_medusa -- OK' IF (lwp) write (numout,*) 'Now, read namilists inside :' IF (lwp) write (numout,*) ' ' # endif ! # if defined key_debug_medusa CALL flush(numout) # endif ! # if defined key_debug_medusa IF (lwp) write (numout,*) '------------------------------' IF (lwp) write (numout,*) 'Jpalm - debug' IF (lwp) write (numout,*) 'Just before reading namelist_medusa :: nammeddia' IF (lwp) write (numout,*) ' ' CALL flush(numout) # endif IF( ( .NOT.lk_iomput .AND. ln_diatrc ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN ! ! Namelist nampisdia ! ------------------- REWIND( numnatp_ref ) ! Namelist nampisdia in reference namelist : Pisces diagnostics READ ( numnatp_ref, nammeddia, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) REWIND( numnatp_cfg ) ! Namelist nampisdia in configuration namelist : Pisces diagnostics READ ( numnatp_cfg, nammeddia, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) IF(lwm) WRITE ( numonp, nammeddia ) # if defined key_debug_medusa IF (lwp) write (numout,*) '------------------------------' IF (lwp) write (numout,*) 'Jpalm - debug' IF (lwp) write (numout,*) 'reading namelist_medusa :: nammeddia OK' IF (lwp) write (numout,*) 'Check number of variable in nammeddia:' IF (lwp) write (numout,*) 'jp_medusa_2d: ',jp_medusa_2d ,'jp_medusa_3d: ',jp_medusa_3d IF (lwp) write (numout,*) ' ' CALL flush(numout) # endif DO jl = 1, jp_medusa_2d jn = jp_msa0_2d + jl - 1 # if defined key_debug_medusa IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 2D' IF (lwp) write (numout,*) jl,'meddia2d-sname: ',meddia2d(jl)%sname IF (lwp) write (numout,*) jl,'meddia2d-lname: ',meddia2d(jl)%lname IF (lwp) write (numout,*) jl,'meddia2d-units: ',meddia2d(jl)%units CALL flush(numout) # endif ctrc2d(jn) = meddia2d(jl)%sname ctrc2l(jn) = meddia2d(jl)%lname ctrc2u(jn) = meddia2d(jl)%units END DO DO jl = 1, jp_medusa_3d jn = jp_msa0_3d + jl - 1 # if defined key_debug_medusa IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 3D' IF (lwp) write (numout,*) jl,'meddia3d-sname: ',meddia3d(jl)%sname IF (lwp) write (numout,*) jl,'meddia3d-lname: ',meddia3d(jl)%lname IF (lwp) write (numout,*) jl,'meddia3d-units: ',meddia3d(jl)%units CALL flush(numout) # endif ctrc3d(jn) = meddia3d(jl)%sname ctrc3l(jn) = meddia3d(jl)%lname ctrc3u(jn) = meddia3d(jl)%units END DO IF(lwp) THEN ! control print # if defined key_debug_medusa IF (lwp) write (numout,*) '------------------------------' IF (lwp) write (numout,*) 'Jpalm - debug' IF (lwp) write (numout,*) 'Var name assignation OK' IF (lwp) write (numout,*) 'next check var names' IF (lwp) write (numout,*) ' ' CALL flush(numout) # endif WRITE(numout,*) WRITE(numout,*) ' Namelist : natadd' DO jl = 1, jp_medusa_3d jn = jp_msa0_3d + jl - 1 WRITE(numout,*) ' 3d diag nb : ', jn, ' short name : ', ctrc3d(jn), & & ' long name : ', ctrc3l(jn), ' unit : ', ctrc3u(jn) END DO WRITE(numout,*) ' ' DO jl = 1, jp_medusa_2d jn = jp_msa0_2d + jl - 1 WRITE(numout,*) ' 2d diag nb : ', jn, ' short name : ', ctrc2d(jn), & & ' long name : ', ctrc2l(jn), ' unit : ', ctrc2u(jn) END DO WRITE(numout,*) ' ' ENDIF ! ENDIF ! # if defined key_debug_medusa CALL flush(numout) # endif ! 1.4 namelist natbio : biological parameters ! ------------------------------------------- xxi = 0. xaln = 0. xald = 0. jphy = 0 xvpn = 0. xvpd = 0. xthetam = 0. xthetamd = 0. !! xsin0 = 0. xnsi0 = 0. xuif = 0. !! jliebig = 0 xnln = 0. xnld = 0. xsld = 0. xfln = 0. xfld = 0. !! xgmi = 0. xgme = 0. xkmi = 0. xkme = 0. xphi = 0. xbetan = 0. xbetac = 0. xkc = 0. xpmipn = 0. xpmid = 0. xpmepn = 0. xpmepd = 0. xpmezmi = 0. xpmed = 0. !! xmetapn = 0. xmetapd = 0. xmetazmi = 0. xmetazme = 0. !! jmpn = 0 xmpn = 0. xkphn = 0. jmpd = 0 xmpd = 0. xkphd = 0. jmzmi = 0 xmzmi = 0. xkzmi = 0. jmzme = 0 xmzme = 0. xkzme = 0. !! jmd = 0 jsfd = 0 xmd = 0. xmdc = 0. !! xthetapn = 0. xthetapd = 0. xthetazmi = 0. xthetazme = 0. xthetad = 0. xrfn = 0. xrsn = 0. !: (NOT USED HERE; RETAINED FOR LOBSTER) !! jiron = 0 xfe_mass = 0. xfe_sol = 0. xfe_sed = 0. xLgT = 0. xk_FeL = 0. xk_sc_Fe = 0. !! jexport = 0 jfdfate = 0 jrratio = 0 jocalccd = 0 xridg_r0 = 0. xfdfrac1 = 0. xfdfrac2 = 0. xfdfrac3 = 0. xcaco3a = 0. xcaco3b = 0. xmassc = 0. xmassca = 0. xmasssi = 0. xprotca = 0. xprotsi = 0. xfastc = 0. xfastca = 0. xfastsi = 0. !! jorgben = 0 jinorgben = 0 xsedn = 0. xsedfe = 0. xsedsi = 0. xsedc = 0. xsedca = 0. xburial = 0. !! jriver_n = 0 jriver_si = 0 jriver_c = 0 jriver_alk = 0 jriver_dep = 1 !! xsdiss = 0. !! vsed = 0. xhr = 0. !! sedlam = 0. sedlostpoc = 0. jpkb = 0. jdms = 0 !REWIND(numnatm) !READ(numnatm,natbio) ! Namelist natbio ! ------------------- REWIND( numnatp_ref ) ! Namelist nampisdia in reference namelist : Pisces diagnostics READ ( numnatp_ref, natbio, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) REWIND( numnatp_cfg ) ! Namelist nampisdia in configuration namelist : Pisces diagnostics READ ( numnatp_cfg, natbio, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) IF(lwm) WRITE ( numonp, natbio ) !! Primary production and chl related quantities !! xxi : conversion factor from gC to mmolN !! xaln : Chl-a specific initial slope of P-I curve for non-diatoms !! xald : Chl-a specific initial slope of P-I curve for diatoms !! jphy : phytoplankton T-dependent growth switch !! xvpn : maximum growth rate for non-diatoms !! xvpd : maximum growth rate for diatoms !! xthetam : maximum Chl to C ratio for non-diatoms !! xthetamd : maximum Chl to C ratio for diatoms !! !! Diatom silicon parameters !! xsin0 : minimum diatom Si:N ratio !! xnsi0 : minimum diatom N:Si ratio !! xuif : hypothetical growth ratio at infinite Si:N ratio !! !! Nutrient limitation !! jliebig : Liebig nutrient uptake switch !! xnln : half-sat constant for DIN uptake by non-diatoms !! xnld : half-sat constant for DIN uptake by diatoms !! xsl : half-sat constant for Si uptake by diatoms !! xfld : half-sat constant for Fe uptake by diatoms !! xfln : half-sat constant for Fe uptake by non-datoms !! !! Grazing !! xgmi : microzoo maximum growth rate !! xgme : mesozoo maximum growth rate !! xkmi : microzoo grazing half-sat parameter !! xkme : mesozoo grazing half-sat parameter !! xphi : micro/mesozoo grazing inefficiency !! xbetan : micro/mesozoo N assimilation efficiency !! xbetac : micro/mesozoo C assimilation efficiency !! xkc : micro/mesozoo net C growth efficiency !! xpmipn : grazing preference of microzoo for non-diatoms !! xpmid : grazing preference of microzoo for diatoms !! xpmepn : grazing preference of mesozoo for non-diatoms !! xpmepd : grazing preference of mesozoo for diatoms !! xpmezmi : grazing preference of mesozoo for microzoo !! xpmed : grazing preference of mesozoo for detritus !! !! Metabolic losses !! xmetapn : non-diatom metabolic loss rate !! xmetapd : diatom metabolic loss rate !! xmetazmi : microzoo metabolic loss rate !! xmetazme : mesozoo metabolic loss rate !! !! Mortality/Remineralisation !! jmpn : non-diatom mortality functional form !! xmpn : non-diatom mortality rate !! xkphn : non-diatom mortality half-sat constant !! jmpd : diatom mortality functional form !! xmpd : diatom mortality rate !! xkphd : diatom mortality half-sat constant !! jmzmi : microzoo mortality functional form !! xmzmi : microzoo mortality rate !! xkzmi : microzoo mortality half-sat constant !! jmzme : mesozoo mortality functional form !! xmzme : mesozoo mortality rate !! xkzme : mesozoo mortality half-sat constant !! !! Remineralisation !! jmd : detritus T-dependent remineralisation switch !! jsfd : accelerate seafloor detritus remin. switch !! xmd : detrital nitrogen remineralisation rate !! xmdc : detrital carbon remineralisation rate !! !! Stochiometric ratios !! xthetapn : non-diatom C:N ratio !! xthetapd : diatom C:N ratio !! xthetazmi : microzoo C:N ratio !! xthetazme : mesozoo C:N ratio !! xthetad : detritus C:N ratio !! xrfn : phytoplankton Fe:N ratio !! xrsn : diatom Si:N ratio (*NOT* used) !! !! Iron parameters !! jiron : iron scavenging submodel switch !! xfe_mass : iron atomic mass !! xfe_sol : aeolian iron solubility !! xfe_sed : sediment iron input !! xLgT : total ligand concentration (umol/m3) !! xk_FeL : dissociation constant for (Fe + L) !! xk_sc_Fe : scavenging rate of "free" iron !! !! Fast-sinking detritus parameters !! jexport : fast detritus remineralisation switch !! jfdfate : fate of fast detritus at seafloor switch !! jrratio : rain ratio switch !! jocalccd : CCD switch !! xridg_r0 : Ridgwell rain ratio coefficient !! xfdfrac1 : fast-sinking fraction of diatom nat. mort. losses !! xfdfrac2 : fast-sinking fraction of meszooplankton mort. losses !! xfdfrac3 : fast-sinking fraction of diatom silicon grazing losses !! xcaco3a : polar (high latitude) CaCO3 fraction !! xcaco3b : equatorial (low latitude) CaCO3 fraction !! xmassc : organic C mass:mole ratio, C106 H175 O40 N16 P1 !! xmassca : calcium carbonate mass:mole ratio, CaCO3 !! xmasssi : biogenic silicon mass:mole ratio, (H2SiO3)n !! xprotca : calcium carbonate protection ratio !! xprotsi : biogenic silicon protection ratio !! xfastc : organic C remineralisation length scale !! xfastca : calcium carbonate dissolution length scale !! xfastsi : biogenic silicon dissolution length scale !! !! Benthic !! jorgben : does organic detritus go to the benthos? !! jinorgben : does inorganic detritus go to the benthos? !! xsedn : organic nitrogen sediment remineralisation rate !! xsedfe : organic iron sediment remineralisation rate !! xsedsi : inorganic silicon sediment dissolution rate !! xsedc : organic carbon sediment remineralisation rate !! xsedca : inorganic carbon sediment dissolution rate !! xburial : burial rate of seafloor detritus !! !! Riverine inputs !! jriver_n : riverine N input? !! jriver_si : riverine Si input? !! jriver_c : riverine C input? !! jriver_alk : riverine alkalinity input? !! jriver_dep : depth of riverine input? !! !! Miscellaneous !! xsdiss : diatom frustule dissolution rate !! !! Gravitational sinking !! vsed : detritus gravitational sinking rate !! xhr : coeff for Martin's remineralisation profile !! !! Additional parameters !! sedlam : time coeff of POC in sediments !! sedlostpoc : sediment geol loss for POC !! jpkb : vertical layer for diagnostic of the vertical flux !! NOTE that in LOBSTER it is a first vertical layers where !! biology is active !! !! UKESM1 - new diagnostics !! Jpalm !! jdms : include dms diagnostics !! !! !! IF(lwp) THEN !! !! AXY (08/11/13): compilation key notification WRITE(numout,*) '=== Compilation keys' #if defined key_roam WRITE(numout,*) & & ' key_roam = ACTIVE' #else WRITE(numout,*) & & ' key_roam = INACTIVE' #endif #if defined key_axy_carbchem WRITE(numout,*) & & ' key_axy_carbchem = ACTIVE' #else WRITE(numout,*) & & ' key_axy_carbchem = INACTIVE' #endif #if defined key_bs_axy_zforce WRITE(numout,*) & & ' key_bs_axy_zforce = ACTIVE' #else WRITE(numout,*) & & ' key_bs_axy_zforce = INACTIVE' #endif #if defined key_bs_axy_yrlen WRITE(numout,*) & & ' key_bs_axy_yrlen = ACTIVE' #else WRITE(numout,*) & & ' key_bs_axy_yrlen = INACTIVE' #endif #if defined key_deep_fe_fix WRITE(numout,*) & & ' key_deep_fe_fix = ACTIVE' #else WRITE(numout,*) & & ' key_deep_fe_fix = INACTIVE' #endif #if defined key_axy_nancheck WRITE(numout,*) & & ' key_axy_nancheck = ACTIVE' #else WRITE(numout,*) & & ' key_axy_nancheck = INACTIVE' #endif # if defined key_axy_pi_co2 WRITE(numout,*) & & ' key_axy_pi_co2 = ACTIVE' #else WRITE(numout,*) & & ' key_axy_pi_co2 = INACTIVE' # endif WRITE(numout,*) ' ' WRITE(numout,*) 'natbio' WRITE(numout,*) ' ' !! !! Primary production and chl related quantities WRITE(numout,*) '=== Primary production' WRITE(numout,*) & & ' conversion factor from gC to mmolN, xxi =', xxi WRITE(numout,*) & & ' Chl-a specific initial slope of P-I curve for non-diatoms, xaln = ', xaln WRITE(numout,*) & & ' Chl-a specific initial slope of P-I curve for diatoms, xald = ', xald if (jphy.eq.1) then WRITE(numout,*) & & ' phytoplankton growth is *temperature-dependent* jphy = ', jphy elseif (jphy.eq.0) then WRITE(numout,*) & & ' phytoplankton growth is *temperature-independent* jphy = ', jphy endif WRITE(numout,*) & & ' maximum growth rate for non-diatoms, xvpn = ', xvpn WRITE(numout,*) & & ' maximum growth rate for diatoms, xvpn = ', xvpd WRITE(numout,*) & & ' maximum Chl to C ratio for non-diatoms, xthetam = ', xthetam WRITE(numout,*) & & ' maximum Chl to C ratio for diatoms, xthetamd = ', xthetamd !! !! Diatom silicon parameters WRITE(numout,*) '=== Diatom silicon parameters' WRITE(numout,*) & & ' minimum diatom Si:N ratio, xsin0 = ', xsin0 WRITE(numout,*) & & ' minimum diatom N:Si ratio, xnsi0 = ', xnsi0 WRITE(numout,*) & & ' hypothetical growth ratio at infinite Si:N ratio, xuif = ', xuif !! !! Nutrient limitation WRITE(numout,*) '=== Nutrient limitation' if (jliebig.eq.1) then WRITE(numout,*) & & ' nutrient uptake is a Liebig Law (= most limiting) function jliebig = ', jliebig elseif (jliebig.eq.0) then WRITE(numout,*) & & ' nutrient uptake is a multiplicative function jliebig = ', jliebig endif WRITE(numout,*) & & ' half-sat constant for DIN uptake by non-diatoms, xnln = ', xnln WRITE(numout,*) & & ' half-sat constant for DIN uptake by diatoms, xnld = ', xnld WRITE(numout,*) & & ' half-sat constant for Si uptake by diatoms, xsld = ', xsld WRITE(numout,*) & & ' half-sat constant for Fe uptake by non-diatoms, xfln = ', xfln WRITE(numout,*) & & ' half-sat constant for Fe uptake by diatoms, xfld = ', xfld !! !! Grazing WRITE(numout,*) '=== Zooplankton grazing' WRITE(numout,*) & & ' microzoo maximum growth rate, xgmi = ', xgmi WRITE(numout,*) & & ' mesozoo maximum growth rate, xgme = ', xgme WRITE(numout,*) & & ' microzoo grazing half-sat parameter, xkmi = ', xkmi WRITE(numout,*) & & ' mesozoo grazing half-sat parameter, xkme = ', xkme WRITE(numout,*) & & ' micro/mesozoo grazing inefficiency, xphi = ', xphi WRITE(numout,*) & & ' micro/mesozoo N assimilation efficiency, xbetan = ', xbetan WRITE(numout,*) & & ' micro/mesozoo C assimilation efficiency, xbetac = ', xbetan WRITE(numout,*) & & ' micro/mesozoo net C growth efficiency, xkc = ', xkc WRITE(numout,*) & & ' grazing preference of microzoo for non-diatoms, xpmipn = ', xpmipn WRITE(numout,*) & & ' grazing preference of microzoo for detritus, xpmid = ', xpmid WRITE(numout,*) & & ' grazing preference of mesozoo for non-diatoms, xpmepn = ', xpmepn WRITE(numout,*) & & ' grazing preference of mesozoo for diatoms, xpmepd = ', xpmepd WRITE(numout,*) & & ' grazing preference of mesozoo for microzoo, xpmezmi = ', xpmezmi WRITE(numout,*) & & ' grazing preference of mesozoo for detritus, xpmed = ', xpmed !! !! Metabolic losses WRITE(numout,*) '=== Metabolic losses' WRITE(numout,*) & & ' non-diatom metabolic loss rate, xmetapn = ', xmetapn WRITE(numout,*) & & ' diatom metabolic loss rate, xmetapd = ', xmetapd WRITE(numout,*) & & ' microzoo metabolic loss rate, xmetazmi = ', xmetazmi WRITE(numout,*) & & ' mesozoo metabolic loss rate, xmetazme = ', xmetazme !! !! Mortality losses WRITE(numout,*) '=== Mortality losses' if (jmpn.eq.1) then WRITE(numout,*) & & ' non-diatom mortality functional form, LINEAR jmpn = ', jmpn elseif (jmpn.eq.2) then WRITE(numout,*) & & ' non-diatom mortality functional form, QUADRATIC jmpn = ', jmpn elseif (jmpn.eq.3) then WRITE(numout,*) & & ' non-diatom mortality functional form, HYPERBOLIC jmpn = ', jmpn elseif (jmpn.eq.4) then WRITE(numout,*) & & ' non-diatom mortality functional form, SIGMOID jmpn = ', jmpn endif WRITE(numout,*) & & ' non-diatom mortality rate, xmpn = ', xmpn WRITE(numout,*) & & ' non-diatom mortality half-sat constant xkphn = ', xkphn if (jmpd.eq.1) then WRITE(numout,*) & & ' diatom mortality functional form, LINEAR jmpd = ', jmpd elseif (jmpd.eq.2) then WRITE(numout,*) & & ' diatom mortality functional form, QUADRATIC jmpd = ', jmpd elseif (jmpd.eq.3) then WRITE(numout,*) & & ' diatom mortality functional form, HYPERBOLIC jmpd = ', jmpd elseif (jmpd.eq.4) then WRITE(numout,*) & & ' diatom mortality functional form, SIGMOID jmpd = ', jmpd endif WRITE(numout,*) & & ' diatom mortality rate, xmpd = ', xmpd WRITE(numout,*) & & ' diatom mortality half-sat constant xkphd = ', xkphd if (jmzmi.eq.1) then WRITE(numout,*) & & ' microzoo mortality functional form, LINEAR jmzmi = ', jmzmi elseif (jmzmi.eq.2) then WRITE(numout,*) & & ' microzoo mortality functional form, QUADRATIC jmzmi = ', jmzmi elseif (jmzmi.eq.3) then WRITE(numout,*) & & ' microzoo mortality functional form, HYPERBOLIC jmzmi = ', jmzmi elseif (jmzmi.eq.4) then WRITE(numout,*) & & ' microzoo mortality functional form, SIGMOID jmzmi = ', jmzmi endif WRITE(numout,*) & & ' microzoo mortality rate, xmzmi = ', xmzmi WRITE(numout,*) & & ' mesozoo mortality half-sat constant, xkzmi = ', xkzmi if (jmzme.eq.1) then WRITE(numout,*) & & ' mesozoo mortality functional form, LINEAR jmzme = ', jmzme elseif (jmzme.eq.2) then WRITE(numout,*) & & ' mesozoo mortality functional form, QUADRATIC jmzme = ', jmzme elseif (jmzme.eq.3) then WRITE(numout,*) & & ' mesozoo mortality functional form, HYPERBOLIC jmzme = ', jmzme elseif (jmzme.eq.4) then WRITE(numout,*) & & ' mesozoo mortality functional form, SIGMOID jmzme = ', jmzme endif WRITE(numout,*) & & ' mesozoo mortality rate, xmzme = ', xmzme WRITE(numout,*) & & ' mesozoo mortality half-sat constant, xkzme = ', xkzme !! !! Remineralisation WRITE(numout,*) '=== Remineralisation' if (jmd.eq.1) then WRITE(numout,*) & & ' detritus remineralisation is *temperature-dependent* jmd = ', jmd elseif (jmd.eq.0) then WRITE(numout,*) & & ' detritus remineralisation is *temperature-independent* jmd = ', jmd endif if (jsfd.eq.1) then WRITE(numout,*) & & ' detritus seafloor remineralisation is *accelerated* jsfd = ', jsfd else WRITE(numout,*) & & ' detritus seafloor remineralisation occurs at same rate jsfd = ', jsfd endif WRITE(numout,*) & & ' detrital nitrogen remineralisation rate, xmd = ', xmd WRITE(numout,*) & & ' detrital carbon remineralisation rate, xmdc = ', xmdc !! !! Stochiometric ratios WRITE(numout,*) '=== Stoichiometric ratios' WRITE(numout,*) & & ' non-diatom C:N ratio, xthetapn = ', xthetapn WRITE(numout,*) & & ' diatom C:N ratio, xthetapd = ', xthetapd WRITE(numout,*) & & ' microzoo C:N ratio, xthetazmi = ', xthetazmi WRITE(numout,*) & & ' mesozoo C:N ratio, xthetazme = ', xthetazme WRITE(numout,*) & & ' detritus C:N ratio, xthetad = ', xthetad WRITE(numout,*) & & ' phytoplankton Fe:N ratio, xrfn = ', xrfn WRITE(numout,*) & & ' diatom Si:N ratio, xrsn = ', xrsn !! !! Iron parameters WRITE(numout,*) '=== Iron parameters' if (jiron.eq.1) then WRITE(numout,*) & & ' Dutkiewicz et al. (2005) iron scavenging jiron = ', jiron elseif (jiron.eq.2) then WRITE(numout,*) & & ' Moore et al. (2004) iron scavenging jiron = ', jiron elseif (jiron.eq.3) then WRITE(numout,*) & & ' Moore et al. (2008) iron scavenging jiron = ', jiron elseif (jiron.eq.4) then WRITE(numout,*) & & ' Galbraith et al. (2010) iron scavenging jiron = ', jiron else WRITE(numout,*) & & ' There is **no** iron scavenging jiron = ', jiron endif WRITE(numout,*) & & ' iron atomic mass, xfe_mass = ', xfe_mass WRITE(numout,*) & & ' aeolian iron solubility, xfe_sol = ', xfe_sol WRITE(numout,*) & & ' sediment iron input, xfe_sed = ', xfe_sed WRITE(numout,*) & & ' total ligand concentration (umol/m3), xLgT = ', xLgT WRITE(numout,*) & & ' dissociation constant for (Fe + L), xk_FeL = ', xk_FeL WRITE(numout,*) & & ' scavenging rate for free iron, xk_sc_Fe = ', xk_sc_Fe !! !! Fast-sinking detritus parameters WRITE(numout,*) '=== Fast-sinking detritus' if (jexport.eq.1) then WRITE(numout,*) & & ' fast-detritus remin. uses Dunne et al. (2007; ballast) jexport = ', jexport elseif (jexport.eq.2) then WRITE(numout,*) & & ' fast-detritus remin. uses Martin et al. (1987) jexport = ', jexport elseif (jexport.eq.2) then WRITE(numout,*) & & ' fast-detritus remin. uses Henson et al. (2011) jexport = ', jexport endif if (jfdfate.eq.1) then WRITE(numout,*) & & ' fast-detritus reaching seafloor becomes slow-detritus jfdfate = ', jfdfate elseif (jfdfate.eq.0) then WRITE(numout,*) & & ' fast-detritus reaching seafloor instantly remineralised jfdfate = ', jfdfate endif #if defined key_roam if (jrratio.eq.0) then WRITE(numout,*) & & ' Dunne et al. (2005) rain ratio submodel jrratio = ', jrratio elseif (jrratio.eq.1) then WRITE(numout,*) & & ' Ridgwell et al. (2007) rain ratio submodel (surface omega) jrratio = ', jrratio elseif (jrratio.eq.2) then WRITE(numout,*) & & ' Ridgwell et al. (2007) rain ratio submodel (3D omega) jrratio = ', jrratio endif #else jrratio = 0 WRITE(numout,*) & & ' Dunne et al. (2005) rain ratio submodel jrratio = ', jrratio #endif #if defined key_roam if (jocalccd.eq.0) then WRITE(numout,*) & & ' Default, fixed CCD used jocalccd = ', jocalccd elseif (jocalccd.eq.1) then WRITE(numout,*) & & ' Calculated, dynamic CCD used jocalccd = ', jocalccd endif #else jocalccd = 0 WRITE(numout,*) & & ' Default, fixed CCD used jocalccd = ', jocalccd #endif WRITE(numout,*) & & ' Ridgwell rain ratio coefficient, xridg_r0 = ', xridg_r0 WRITE(numout,*) & & ' fast-sinking fraction of diatom nat. mort. losses, xfdfrac1 = ', xfdfrac1 WRITE(numout,*) & & ' fast-sinking fraction of mesozooplankton mort. losses, xfdfrac2 = ', xfdfrac2 WRITE(numout,*) & & ' fast-sinking fraction of diatom silicon grazing losses, xfdfrac3 = ', xfdfrac3 WRITE(numout,*) & & ' polar (high latitude) CaCO3 fraction, xcaco3a = ', xcaco3a WRITE(numout,*) & & ' equatorial (low latitude) CaCO3 fraction, xcaco3b = ', xcaco3b WRITE(numout,*) & & ' organic C mass:mole ratio, C106 H175 O40 N16 P1, xmassc = ', xmassc WRITE(numout,*) & & ' calcium carbonate mass:mole ratio, CaCO3, xmassca = ', xmassca WRITE(numout,*) & & ' biogenic silicon mass:mole ratio, (H2SiO3)n, xmasssi = ', xmasssi WRITE(numout,*) & & ' calcium carbonate protection ratio, xprotca = ', xprotca WRITE(numout,*) & & ' biogenic silicon protection ratio, xprotsi = ', xprotsi WRITE(numout,*) & & ' organic C remineralisation length scale, xfastc = ', xfastc WRITE(numout,*) & & ' calcium carbonate dissolution length scale, xfastca = ', xfastca WRITE(numout,*) & & ' biogenic silicon dissolution length scale, xfastsi = ', xfastsi !! !! Benthos parameters WRITE(numout,*) '=== Benthos parameters' WRITE(numout,*) & & ' does organic detritus go to the benthos?, jorgben = ', jorgben WRITE(numout,*) & & ' does inorganic detritus go to the benthos?, jinorgben = ', jinorgben !! !! Some checks on parameters related to benthos parameters if (jorgben.eq.1 .and. jsfd.eq.1) then !! slow detritus going to benthos at an accelerated rate WRITE(numout,*) ' === WARNING! ===' WRITE(numout,*) ' jsfd *and* jorgben are active - please check that you wish this' WRITE(numout,*) ' === WARNING! ===' endif if (jorgben.eq.1 .and. jfdfate.eq.1) then !! fast detritus going to benthos but via slow detritus WRITE(numout,*) ' === WARNING! ===' WRITE(numout,*) ' jfdfate *and* jorgben are active - please check that you wish this' WRITE(numout,*) ' === WARNING! ===' endif if (jorgben.eq.0 .and. jinorgben.eq.1) then !! inorganic fast detritus going to benthos but organic fast detritus is not WRITE(numout,*) ' === WARNING! ===' WRITE(numout,*) ' jinorgben is active but jorgben is not - please check that you wish this' WRITE(numout,*) ' === WARNING! ===' endif WRITE(numout,*) & & ' organic nitrogen sediment remineralisation rate, xsedn = ', xsedn WRITE(numout,*) & & ' organic iron sediment remineralisation rate, xsedfe = ', xsedfe WRITE(numout,*) & & ' inorganic silicon sediment remineralisation rate, xsedsi = ', xsedsi WRITE(numout,*) & & ' organic carbon sediment remineralisation rate, xsedc = ', xsedc WRITE(numout,*) & & ' inorganic carbon sediment remineralisation rate, xsedca = ', xsedca WRITE(numout,*) & & ' burial rate of seafloor detritus, xburial = ', xburial !! !! Riverine inputs WRITE(numout,*) '=== Riverine inputs' if (jriver_n.eq.0) then WRITE(numout,*) & & ' *no* riverine N input, jriver_n = ', jriver_n elseif (jriver_n.eq.1) then WRITE(numout,*) & & ' riverine N concentrations specified, jriver_n = ', jriver_n elseif (jriver_n.eq.2) then WRITE(numout,*) & & ' riverine N inputs specified, jriver_n = ', jriver_n endif if (jriver_si.eq.0) then WRITE(numout,*) & & ' *no* riverine Si input, jriver_si = ', jriver_si elseif (jriver_si.eq.1) then WRITE(numout,*) & & ' riverine Si concentrations specified, jriver_si = ', jriver_si elseif (jriver_si.eq.2) then WRITE(numout,*) & & ' riverine Si inputs specified, jriver_si = ', jriver_si endif if (jriver_c.eq.0) then WRITE(numout,*) & & ' *no* riverine C input, jriver_c = ', jriver_c elseif (jriver_c.eq.1) then WRITE(numout,*) & & ' riverine C concentrations specified, jriver_c = ', jriver_c elseif (jriver_c.eq.2) then WRITE(numout,*) & & ' riverine C inputs specified, jriver_c = ', jriver_c endif if (jriver_alk.eq.0) then WRITE(numout,*) & & ' *no* riverine alkalinity input, jriver_alk = ', jriver_alk elseif (jriver_alk.eq.1) then WRITE(numout,*) & & ' riverine alkalinity concentrations specified, jriver_alk = ', jriver_alk elseif (jriver_alk.eq.2) then WRITE(numout,*) & & ' riverine alkalinity inputs specified, jriver_alk = ', jriver_alk endif !! AXY (19/07/12): prevent (gross) stupidity on part of user if (jriver_dep.lt.1.or.jriver_dep.ge.jpk) then jriver_dep = 1 endif WRITE(numout,*) & & ' riverine input applied to down to depth k = ... jriver_dep = ', jriver_dep !! !! Miscellaneous WRITE(numout,*) '=== Miscellaneous' WRITE(numout,*) & & ' diatom frustule dissolution rate, xsdiss = ', xsdiss !! !! Gravitational sinking WRITE(numout,*) '=== Gravitational sinking' WRITE(numout,*) & & ' detritus gravitational sinking rate, vsed = ', vsed WRITE(numout,*) & & ' coefficient for Martin et al. (1987) remineralisation, xhr = ', xhr !! !! Non-Medusa parameters WRITE(numout,*) '=== Non-Medusa parameters' WRITE(numout,*) & & ' time coeff of POC in sediments, sedlam = ', sedlam WRITE(numout,*) & & ' Sediment geol loss for POC, sedlostpoc = ', sedlostpoc WRITE(numout,*) & & ' Vert layer for diagnostic of vertical flux, jpkp = ', jpkb !! !! UKESM1 - new diagnostics !! Jpalm WRITE(numout,*) '=== UKESM1-related parameters' WRITE(numout,*) & & ' include DMS diagnostic?, jdms = ', jdms !! ENDIF !! !! Key depth positions (with thanks to Andrew Coward for bug-fixing this bit) DO jk = 1,jpk !! level thickness fthk = e3t_1d(jk) !! level depth (top of level) fdep = gdepw_1d(jk) !! level depth (bottom of level) fdep1 = fdep + fthk !! if (fdep.lt.100.0.AND.fdep1.gt.100.0) then ! 100 m i0100 = jk elseif (fdep.lt.150.0.AND.fdep1.gt.150.0) then ! 150 m (for BASIN) i0150 = jk elseif (fdep.lt.200.0.AND.fdep1.gt.200.0) then ! 200 m i0200 = jk elseif (fdep.lt.500.0.AND.fdep1.gt.500.0) then ! 500 m i0500 = jk elseif (fdep.lt.1000.0.AND.fdep1.gt.1000.0) then ! 1000 m i1000 = jk elseif (fdep1.lt.1100.0) then ! 1100 m (for Moore et al. sedimentary iron) i1100 = jk endif enddo !! IF(lwp) THEN WRITE(numout,*) '=== Position of key depths' WRITE(numout,*) & & ' jk position of 100 m horizon i0100 = ', i0100 WRITE(numout,*) & & ' jk position of 150 m horizon i0150 = ', i0150 WRITE(numout,*) & & ' jk position of 200 m horizon i0200 = ', i0200 WRITE(numout,*) & & ' jk position of 500 m horizon i0500 = ', i0500 WRITE(numout,*) & & ' jk position of 1000 m horizon i1000 = ', i1000 WRITE(numout,*) & & ' jk position of 1100 m horizon [*] i1100 = ', i1100 WRITE(numout,*) 'Got here ' , SIZE(friver_dep) CALL flush(numout) ENDIF #if defined key_roam ! 1.4b namelist natroam : ROAM parameters ! --------------------------------------- xthetaphy = 0. xthetazoo = 0. xthetanit = 0. xthetarem = 0. xo2min = 0. !READ(numnatm,natroam) ! Namelist natbio ! ------------------- REWIND( numnatp_ref ) ! Namelist nampisdia in reference namelist : Pisces diagnostics READ ( numnatp_ref, natbio, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) REWIND( numnatp_cfg ) ! Namelist nampisdia in configuration namelist : Pisces diagnostics READ ( numnatp_cfg, natbio, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) IF(lwm) WRITE ( numonp, natbio ) !! ROAM carbon, alkalinity and oxygen cycle parameters !! xthetaphy : oxygen evolution/consumption by phytoplankton !! xthetazoo : oxygen consumption by zooplankton !! xthetanit : oxygen consumption by nitrogen remineralisation !! xthetarem : oxygen consumption by carbon remineralisation !! xo2min : oxygen minimum concentration IF(lwp) THEN WRITE(numout,*) 'natroam' WRITE(numout,*) ' ' !! !! ROAM carbon, alkalinity and oxygen cycle parameters WRITE(numout,*) '=== ROAM carbon, alkalinity and oxygen cycle parameters' WRITE(numout,*) & & ' oxygen evolution/consumption by phytoplankton xthetaphy = ', xthetaphy WRITE(numout,*) & & ' oxygen consumption by zooplankton xthetazoo = ', xthetazoo WRITE(numout,*) & & ' oxygen consumption by nitrogen remineralisation xthetanit = ', xthetanit WRITE(numout,*) & & ' oxygen consumption by carbon remineralisation xthetarem = ', xthetarem WRITE(numout,*) & & ' oxygen minimum concentration xo2min = ', xo2min ENDIF #endif CALL flush(numout) ! 1.5 namelist natopt : parameters for optic ! ------------------------------------------ xkg0 = 0. xkr0 = 0. xkgp = 0. xkrp = 0. xlg = 0. xlr = 0. rpig = 0. !READ(numnatm,natopt) ! Namelist natopt ! ------------------- REWIND( numnatp_ref ) ! Namelist nampisdia in reference namelist : Pisces diagnostics READ ( numnatp_ref, natopt, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) REWIND( numnatp_cfg ) ! Namelist nampisdia in configuration namelist : Pisces diagnostics READ ( numnatp_cfg, natopt, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) IF(lwm) WRITE ( numonp, natopt ) IF(lwp) THEN WRITE(numout,*) 'natopt' WRITE(numout,*) ' ' WRITE(numout,*) ' green water absorption coeff xkg0 = ',xkg0 WRITE(numout,*) ' red water absorption coeff xkr0 = ',xkr0 WRITE(numout,*) ' pigment red absorption coeff xkrp = ',xkrp WRITE(numout,*) ' pigment green absorption coeff xkgp = ',xkgp WRITE(numout,*) ' green chl exposant xlg = ',xlg WRITE(numout,*) ' red chl exposant xlr = ',xlr WRITE(numout,*) ' chla/chla+phea ratio rpig = ',rpig WRITE(numout,*) ' ' ENDIF IF(lwp) THEN WRITE(numout,*) 'NaN check' WRITE(numout,*) ' ' q1 = -1. q2 = 0. q3 = log(q1) write (numout,*) 'q3 = ', q3 if ( ieee_is_nan( q3 ) ) then write (numout,*) 'NaN detected' else write (numout,*) 'NaN not detected' endif WRITE(numout,*) ' ' ENDIF END SUBROUTINE trc_nam_medusa #else !!---------------------------------------------------------------------- !! Dummy module : No MEDUSA !!---------------------------------------------------------------------- CONTAINS SUBROUTINE trc_nam_medusa ! Empty routine END SUBROUTINE trc_nam_medusa #endif !!====================================================================== END MODULE trcnam_medusa