subroutine bioparm c c======================================================================= c === c This routine reads in the control parameters for the biological === c module. This particular version reads the parameters for the === c Dusenberry model (CPP option "bioDuse") === c === c======================================================================= c c----------------------------------------------------------------------- c Define global data. c----------------------------------------------------------------------- c #include #include #include #include #include c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c integer i,icard,ios,iunit,sbgn,sbn2,send,slen,sln2,snd2 c parameter (iunit=90) c c======================================================================= c Begin executable code. c======================================================================= c c----------------------------------------------------------------------- c Open input file for Dusenberry biological Model. c----------------------------------------------------------------------- c call length (bparnam,slen,sbgn,send) if (slen.lt.1) then write (stdout,900) 'biological parameters' call exitus ('BIOPARM') end if c open (bioinp, file=bparnam(sbgn:send), form='formatted', * status='old', iostat=ios) if (ios.ne.0) then write (stdout,910) bparnam(sbgn:send) call exitus ('BIOPARM') end if c write(stdout,1070) c c----------------------------------------------------------------------- c Read in input parameters for Dusenberry biological Model. c----------------------------------------------------------------------- c read (bioinp,*,iostat=ios) icard c do 20 while ((ios.eq.0) .and. (icard.gt.0) .and. (icard.lt.99)) c if (icard.eq.1) then read (bioinp,*,iostat=ios) attphy,parfrac if (ios.eq.0) then write (stdout,1080) attphy,parfrac attphy=attphy*cm2m end if c elseif (icard.eq.2) then read(bioinp,*,iostat=ios) photorm,photor0,photoinh,phim if (ios.eq.0) then write(stdout,1090) photorm,photor0,photoinh,phim end if c elseif (icard.eq.3) then read (bioinp,*,iostat=ios) hsno3,hsnh4,no3inh if (ios.eq.0) write (stdout,1100) hsno3,hsnh4,no3inh c elseif (icard.eq.4) then read (bioinp,*,iostat=ios) nquota,no3urm,nh4urm if (ios.eq.0) then write(stdout,1110) nquota,no3urm,nh4urm no3urm=no3urm*sec2day nh4urm=nh4urm*sec2day end if c elseif (icard.eq.5) then read (bioinp,*,iostat=ios) phylr1,phylr2 if (ios.eq.0) then write(stdout,1120) phylr1,phylr2 phylr1=phylr1*sec2day phylr2=phylr2*sec2day end if c elseif (icard.eq.6) then read (bioinp,*,iostat=ios) grazrm,civlev,zooexcn,zooexcd if (ios.eq.0) then write(stdout,1130) grazrm,civlev,zooexcn,zooexcd grazrm=grazrm*sec2day end if c elseif (icard.eq.7) then read (bioinp,*,iostat=ios) zoolr1,zoolr2,zoolf1,zoolf2 if (ios.eq.0) then write (stdout,1140) zoolr1,zoolr2,zoolf1,zoolf2 zoolr1=zoolr1*sec2day zoolr2=zoolr2*sec2day end if c elseif (icard.eq.8) then read (bioinp,*,iostat=ios) wsnkphy,wsnkdet,fracrmn if (ios.eq.0) then write (stdout,1150) wsnkphy,wsnkdet,fracrmn if (wsnkphy.gt.c0) wsnkphy=wsnkphy*sec2day*m2cm wsnkdet=wsnkdet*sec2day*m2cm end if c elseif (icard.eq.9) then read (bioinp,*,iostat=ios) remnnh4,remndet if (ios.eq.0) then write (stdout,1160) remnnh4,remndet remnnh4=remnnh4*sec2day remndet=remndet*sec2day end if c elseif (icard.eq.10) then read (bioinp,*,iostat=ios) biopos,ipmod if (ios.eq.0) write (stdout,1170) biopos,ipmod c elseif (icard.eq.11) then read (bioinp,*,iostat=ios) c2n,c2chl,cha2chb,cha2chc, * cha2psc,cha2ppc if (ios.eq.0) write (stdout,1180) c2n,c2chl,cha2chb,cha2chc, * cha2psc,cha2ppc #if !defined codunlim & !defined codlim c elseif (icard.eq.12) then read (bioinp,*,iostat=ios) (ibiout(i),i=1,10) c elseif (icard.eq.13) then read (bioinp,*,iostat=ios) absonam if (ios.eq.0) then call length (absonam,sln2,sbn2,snd2) if (sln2.gt.0) then write (stdout,90) 'Pigment Absorption Coefficients '// & 'File: ',absonam(sbn2:snd2) end if end if end if # else c elseif (icard.eq.12) then read (bioinp,*,iostat=ios) cdzmin,cdzmax,cdkz,cdkp,cdtmin, & cdtmax,cdkt,cdspd,cdwmax if (ios.eq.0) then # ifdef codunlim write (stdout,1190) cdzmin,cdzmax,cdkz,cdkp,cdtmin, * cdtmax,cdkt,cdwmax # else write (stdout,1190) cdzmin,cdzmax,cdkz,cdkp,cdtmin, * cdtmax,cdkt,cdspd,cdwmax # endif cdzmin = cdzmin*m2cm cdzmax = cdzmax*m2cm end if c elseif (icard.eq.13) then read (bioinp,*,iostat=ios) (ibiout(i),i=1,10) c elseif (icard.eq.14) then read (bioinp,*,iostat=ios) (ibiout(i),i=11,20) c elseif (icard.eq.15) then read (bioinp,*,iostat=ios) absonam if (ios.eq.0) then call length (absonam,sln2,sbn2,snd2) if (sln2.gt.0) then write (stdout,90) 'Pigment Absorption Coefficients '// & 'File: ',absonam(sbn2:snd2) end if end if end if #endif c if (ios.eq.0) read (bioinp,*,iostat=ios) icard 20 continue c if (ios.ne.0) then write (stdout,920) icard call exitus ('BIOPARM') endif c close(bioinp) c c----------------------------------------------------------------------- c Read in spectral absorption coefficients for Bidigare model c----------------------------------------------------------------------- c if(ipmod.eq.ipmbid) then if (sln2.lt.1) then write (stdout,900) 'spectral parameters' call exitus ('BIOPARM') end if open (iunit, file=absonam(sbn2:snd2), status='old', * iostat=ios) if (ios.ne.0) then write (stdout,910) absonam(sbn2:snd2) call exitus ('BIOPARM') end if call aphread endif c return c 90 format (2x,a,a) 900 format (/'***Error: BIOPARM - invalid file name (',a,'), blank', & 'field') 910 format (/' BIOPARM - could not find input file: ',1h",a,1h") 920 format (/' BIOPARM - read error at or near biological input card:' & ,1x,i4) 1070 format(/' Biological model input parameters:'/) 1080 format( * f10.4,' ATTPHY phytoplankton light attenuation scale ', * '(liter umoles-1 m-1)'/ * f10.4,' PARFRAC fraction of shortwave radiation that is ', * 'PAR (nondim)') 1090 format( * f10.4,' PHOTORM maximum photosynthetic rate (1/day)'/ * f10.4,' PHOTOR0 initial slope of photosynthesic light ', * 'response (cm^2/cal)'/ * f10.4,' PHOTOINH photoinhibition response (cm^2/cal)'/ * f10.4,' PHIM phi max (molC/mol photons)') 1100 format( * f10.4,' HSNO3 half saturation constant for nitrate uptake ', * '(umoles/l)'/ * f10.4,' HSNH4 half saturation constant for ammonium uptake ', * '(umoles/l)'/ * f10.4,' NO3INH strength of NH4 inhibition of NO3 ', * 'uptake (l/umoles)') 1110 format( * f10.4,' NQUOTA minimum nitrogen quota (umoles N/ug Chl) '/ * f10.4,' NO3URM maximum nitrate uptake rate ', * '(umoles N/ug Chl 1/day) '/ * f10.4,' NH4URM maximum ammonium uptake rate ', * '(umoles N/ug Chl 1/day) ') 1120 format( * f10.4,' PHYLR1 linear phytoplankton mortality rate (1/day)'/ * f10.4,' PHYLR2 quadratic phytoplankton mortality rate ', * '(1/day l/umoles)') 1130 format( * f10.4,' GRAZRM maximum zooplankton grazing rate ', * '(1/day)'/0p, * f10.4,' CIVLEV Ivlev phytoplankton grazing constant ', * '(l/umoles)'/ * f10.4,' ZOOEXCN heterotroph ammonium excretion fraction ', * '(nondimensional)'/ * f10.4,' ZOOEXCD heterotroph detritus excretion fraction ', * '(nondimensional)') 1140 format( * f10.4,' ZOOLR1 linear heterotrophic loss rate (1/s)'/ * f10.4,' ZOOLR2 quadratic heterotrophic loss rate ', * '(1/day l/umoles)'/0p, * f10.4,' ZOOLF1 fraction of linear heterotroph loss ', * 'to detritus (nondim)'/ * f10.4,' ZOOLF2 fraction of quadratic heterotroph loss ', * 'to detritus (nondim)') 1150 format( * f10.4,' WSNKPHY phytoplankton sinking rate (positive down; ', * 'm/day)'/ * f10.4,' WSNKDET detritus sinking rate (positive down; ', * 'm/day)'/ * f10.4,' FRACRMN fraction of flux sinking out the bottom ', * 'that remineralizes (nondim)') 1160 format( * f10.4,' REMNNH4 NH4 remineralization (nitrification) ', * 'timescale (1/day)'/ * f10.4,' REMNDET detritus remineralization ', * 'timescale (1/day)') 1170 format( * 4x,i6,' BIOPOS switch to enforce non-negative biological ', * 'tracers'/ * 4x,i6,' IPMOD productivity model index') 1180 format( *1pe10.3,' C2N Nitrogen:Carbon Ratio of Phytoplankton ', * '(mol N/mol C)'/ *1pe10.3,' C2CHL Chlorophyl:Carbon ratio (mg Chl/ mol C)'/ *1pe10.3,' CHA2CHB Chl a to Chl b conversion (b:a ratio) ', * '(mg/mg)'/ *1pe10.3,' CHA2CHC Chl a to Chl c conversion (c:a ratio) ', * '(mg/mg)'/ *1pe10.3,' CHA2PSC Chl a to PS carotenoids (psc:a ratio) ', * '(mg/mg)'/ *1pe10.3,' CHA2PPC Chl a to PP carotenoids (ppc:a ratio) ', * '(mg/mg)') #if defined codunlim 1190 format( *1pe10.3,' CDZMIN Cod minimum preferred depth (m)'/ *1pe10.3,' CDZMAX Cod maximum preferred depth (m)'/ *1pe10.3,' CDKZ Cod response to depth coefficient (cm/s)'/ *1pe10.3,' CDKP Cod response to prey coefficient ', * '(cm^2 l)/(s umole N)'/ *1pe10.3,' CDTMIN Cod minimum preferred temperature (deg C)'/ *1pe10.3,' CDTMAX Cod maximum preferred temperature (deg C)'/ *1pe10.3,' CDKT Cod response to temperature coefficient ', * 'cm^2/[s (deg C)^2]'/ *1pe10.3,' CDWMAX Cod maximum vertical swimming speed (cm/s)') # elif defined codlim 1190 format( *1pe10.3,' CDZMIN Cod minimum preferred depth (m)'/ *1pe10.3,' CDZMAX Cod maximum preferred depth (m)'/ *1pe10.3,' CDKZ Cod response to depth coefficient (nondim)'/ *1pe10.3,' CDKP Cod response to prey coefficient ', * '(cm l)/(umole N)'/ *1pe10.3,' CDTMIN Cod minimum preferred temperature (deg C)'/ *1pe10.3,' CDTMAX Cod maximum preferred temperature (deg C)'/ *1pe10.3,' CDKT Cod response to temperature coefficient ', * 'cm/(deg C)^2'/ *1pe10.3,' CDSPD Cod maximum swimming speed (cm/s)'/ *1pe10.3,' CDWMAX Cod maximum vertical swimming speed (cm/s)') #endif c end