SUBROUTINE read_BioPar (model, inp, out, Lwrite) ! !svn $Id: npzd_Franks_inp.h 412 2009-12-03 20:46:03Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2009 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.txt ! !======================================================================= ! ! ! This routine reads in Franks et al. (1986) ecosystem model input ! ! parameters. They are specified in input script "npzd_Franks.in". ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_biology USE mod_ncparam USE mod_scalars ! implicit none ! ! Imported variable declarations ! logical, intent(in) :: Lwrite integer, intent(in) :: model, inp, out ! ! Local variable declarations. ! integer :: Npts, Nval, i, itrc, ng, status integer :: decode_line, load_i, load_l, load_r logical, dimension(NBT,Ngrids) :: Ltrc real(r8), dimension(NBT,Ngrids) :: Rbio real(r8), dimension(100) :: Rval character (len=40) :: KeyWord character (len=160) :: line character (len=160), dimension(100) :: Cval ! !----------------------------------------------------------------------- ! Read in NPZD biological model (Franks et al., 1986) parameters. !----------------------------------------------------------------------- ! #ifdef ANA_BIOLOGY IF (.not.allocated(BioIni)) allocate ( BioIni(MT,Ngrids) ) #endif DO WHILE (.TRUE.) READ (inp,'(a)',ERR=10,END=20) line status=decode_line(line, KeyWord, Nval, Cval, Rval) IF (status.gt.0) THEN IF (TRIM(KeyWord).eq.'Lbiology') THEN Npts=load_l(Nval, Cval, Ngrids, Lbiology) ELSE IF (TRIM(KeyWord).eq.'BioIter') THEN Npts=load_i(Nval, Rval, Ngrids, BioIter) #ifdef ANA_BIOLOGY ELSE IF (TRIM(KeyWord).eq.'BioIni(iNO3_)') THEN Npts=load_r(Nval, Rval, Ngrids, BioIni(iNO3_,1)) ELSE IF (TRIM(KeyWord).eq.'BioIni(iPhyt)') THEN Npts=load_r(Nval, Rval, Ngrids, BioIni(iPhyt,1)) ELSE IF (TRIM(KeyWord).eq.'BioIni(iZoop)') THEN Npts=load_r(Nval, Rval, Ngrids, BioIni(iZoop,1)) ELSE IF (TRIM(KeyWord).eq.'BioIni(iSDet)') THEN Npts=load_r(Nval, Rval, Ngrids, BioIni(iSDet,1)) #endif ELSE IF (TRIM(KeyWord).eq.'K_ext') THEN Npts=load_r(Nval, Rval, Ngrids, K_ext) ELSE IF (TRIM(KeyWord).eq.'K_NO3') THEN Npts=load_r(Nval, Rval, Ngrids, K_NO3) ELSE IF (TRIM(KeyWord).eq.'K_Phy') THEN Npts=load_r(Nval, Rval, Ngrids, K_Phy) ELSE IF (TRIM(KeyWord).eq.'Vm_NO3') THEN Npts=load_r(Nval, Rval, Ngrids, Vm_NO3) ELSE IF (TRIM(KeyWord).eq.'PhyMR') THEN Npts=load_r(Nval, Rval, Ngrids, PhyMR) ELSE IF (TRIM(KeyWord).eq.'ZooGR') THEN Npts=load_r(Nval, Rval, Ngrids, ZooGR) ELSE IF (TRIM(KeyWord).eq.'ZooMR') THEN Npts=load_r(Nval, Rval, Ngrids, ZooMR) ELSE IF (TRIM(KeyWord).eq.'ZooMD') THEN Npts=load_r(Nval, Rval, Ngrids, ZooMD) ELSE IF (TRIM(KeyWord).eq.'ZooGA') THEN Npts=load_r(Nval, Rval, Ngrids, ZooGA) ELSE IF (TRIM(KeyWord).eq.'ZooEC') THEN Npts=load_r(Nval, Rval, Ngrids, ZooEC) ELSE IF (TRIM(KeyWord).eq.'DetRR') THEN Npts=load_r(Nval, Rval, Ngrids, DetRR) ELSE IF (TRIM(KeyWord).eq.'wDet') THEN Npts=load_r(Nval, Rval, Ngrids, wDet) ELSE IF (TRIM(KeyWord).eq.'TNU2') THEN Npts=load_r(Nval, Rval, NBT*Ngrids, Rbio) DO ng=1,Ngrids DO itrc=1,NBT i=idbio(itrc) nl_tnu2(i,ng)=Rbio(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'TNU4') THEN Npts=load_r(Nval, Rval, NBT*Ngrids, Rbio) DO ng=1,Ngrids DO itrc=1,NBT i=idbio(itrc) nl_tnu4(i,ng)=Rbio(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_TNU2') THEN Npts=load_r(Nval, Rval, NBT*Ngrids, Rbio) DO ng=1,Ngrids DO itrc=1,NBT i=idbio(itrc) ad_tnu2(i,ng)=Rbio(itrc,ng) tl_tnu2(i,ng)=Rbio(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_TNU4') THEN Npts=load_r(Nval, Rval, NBT*Ngrids, Rbio) DO ng=1,Ngrids DO itrc=1,NBT i=idbio(itrc) ad_tnu4(i,ng)=Rbio(itrc,ng) ad_tnu4(i,ng)=Rbio(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'AKT_BAK') THEN Npts=load_r(Nval, Rval, NBT*Ngrids, Rbio) DO ng=1,Ngrids DO itrc=1,NBT i=idbio(itrc) Akt_bak(i,ng)=Rbio(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_AKT_fac') THEN Npts=load_r(Nval, Rval, NBT*Ngrids, Rbio) DO ng=1,Ngrids DO itrc=1,NBT i=idbio(itrc) ad_Akt_fac(i,ng)=Rbio(itrc,ng) tl_Akt_fac(i,ng)=Rbio(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'TNUDG') THEN Npts=load_r(Nval, Rval, NBT*Ngrids, Rbio) DO ng=1,Ngrids DO itrc=1,NBT i=idbio(itrc) Tnudg(i,ng)=Rbio(itrc,ng) END DO END DO #ifdef TS_PSOURCE ELSE IF (TRIM(KeyWord).eq.'LtracerSrc') THEN Npts=load_l(Nval, Cval, NBT*Ngrids, Ltrc) DO ng=1,Ngrids DO itrc=1,NBT i=idbio(itrc) LtracerSrc(i,ng)=Ltrc(itrc,ng) END DO END DO #endif ELSE IF (TRIM(KeyWord).eq.'Hout(idTvar)') THEN Npts=load_l(Nval, Cval, NBT*Ngrids, Ltrc) DO ng=1,Ngrids DO itrc=1,NBT i=idTvar(idbio(itrc)) IF (i.eq.0) THEN IF (Master) WRITE (out,30) & & 'idTvar(idbio(', itrc, '))' exit_flag=5 RETURN END IF Hout(i,ng)=Ltrc(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(idTsur)') THEN Npts=load_l(Nval, Cval, NBT*Ngrids, Ltrc) DO ng=1,Ngrids DO itrc=1,NBT i=idTsur(idbio(itrc)) IF (i.eq.0) THEN IF (Master) WRITE (out,30) & & 'idTsur(idbio(', itrc, '))' exit_flag=5 RETURN END IF Hout(i,ng)=Ltrc(itrc,ng) END DO END DO END IF END IF END DO 10 IF (Master) WRITE (out,40) line exit_flag=4 RETURN 20 CONTINUE ! !----------------------------------------------------------------------- ! Report input parameters. !----------------------------------------------------------------------- ! IF (Lwrite) THEN DO ng=1,Ngrids IF (Lbiology(ng)) THEN WRITE (out,50) ng WRITE (out,60) BioIter(ng), 'BioIter', & & 'Number of iterations for nonlinear convergence.' #ifdef ANA_BIOLOGY WRITE (out,70) BioIni(iNO3_,ng), 'BioIni(iNO3_)', & & 'Nitrate initial concentration (mmol/m3).' WRITE (out,70) BioIni(iPhyt,ng), 'BioIni(iPhyt)', & & 'Phytoplankton initial concentration (mmol/m3).' WRITE (out,70) BioIni(iZoop,ng), 'BioIni(iZoop)', & & 'Zooplankton initial concentration (mmol/m3).' WRITE (out,70) BioIni(iSDet,ng), 'BioIni(iSDet)', & & 'Small detritus initial concentration (mmol/m3).' #endif WRITE (out,70) K_ext(ng), 'K_ext', & & 'Light extinction coefficient (m-1).' WRITE (out,80) K_NO3(ng), 'K_NO3', & & 'Inverse half-saturation for phytoplankton NO3', & & 'uptake (1/(mmol m-3)).' WRITE (out,80) K_Phy(ng), 'K_Phy', & & 'Phytoplankton saturation coefficient', & & '(mmol/m3)^2.' WRITE (out,70) Vm_NO3(ng), 'Vm_NO3', & & 'Nitrate upatake rate (day-1).' WRITE (out,70) PhyMR(ng), 'PhyMR', & & 'Phytoplankton senescence/mortality rate (day-1)' WRITE (out,70) ZooGR(ng), 'ZooGR', & & 'Zooplankton maximum growth rate (day-1).' WRITE (out,70) ZooMR(ng), 'ZooMR', & & 'Zooplankton mortality rate (day-1).' WRITE (out,70) ZooMD(ng), 'ZooMD', & & 'Zooplankton death bits rate (day-1).' WRITE (out,70) ZooGA(ng), 'ZooGA', & & 'Zooplankton grazing inefficiency (nondimensional).' WRITE (out,70) ZooEC(ng), 'ZooEC', & & 'Zooplankton excreted fraction (nondimensional).' WRITE (out,70) DetRR(ng), 'DetRR', & & 'Detritus remineralization rate (day-1).' WRITE (out,70) wDet(ng), 'wDet', & & 'Detrital sinking rate (m/day).' #ifdef TS_DIF2 DO itrc=1,NBT i=idbio(itrc) WRITE (out,90) nl_tnu2(i,ng), 'nl_tnu2', i, & & 'NLM Horizontal, harmonic mixing coefficient', & & '(m2/s) for tracer ', i, TRIM(Vname(1,idTvar(i))) # ifdef ADJOINT WRITE (out,90) ad_tnu2(i,ng), 'ad_tnu2', i, & & 'ADM Horizontal, harmonic mixing coefficient', & & '(m2/s) for tracer ', i, TRIM(Vname(1,idTvar(i))) # endif # if defined TANGENT || defined TL_IOMS WRITE (out,90) tl_tnu2(i,ng), 'tl_tnu2', i, & & 'TLM Horizontal, harmonic mixing coefficient', & & '(m2/s) for tracer ', i, TRIM(Vname(1,idTvar(i))) # endif END DO #endif #ifdef TS_DIF4 DO itrc=1,NBT i=idbio(itrc) WRITE (out,90) nl_tnu4(i,ng), 'nl_tnu4', i, & & 'NLM Horizontal, biharmonic mixing coefficient', & & '(m4/s) for tracer ', i, TRIM(Vname(1,idTvar(i))) # ifdef ADJOINT WRITE (out,90) ad_tnu4(i,ng), 'ad_tnu4', i, & & 'ADM Horizontal, biharmonic mixing coefficient', & & '(m4/s) for tracer ', i, TRIM(Vname(1,idTvar(i))) # endif # if defined TANGENT || defined TL_IOMS WRITE (out,90) tl_tnu4(i,ng), 'tl_tnu4', i, & & 'TLM Horizontal, biharmonic mixing coefficient', & & '(m4/s) for tracer ', i, TRIM(Vname(1,idTvar(i))) # endif END DO #endif DO itrc=1,NBT i=idbio(itrc) WRITE(out,90) Akt_bak(i,ng), 'Akt_bak', i, & & 'Background vertical mixing coefficient (m2/s)', & & 'for tracer ', i, TRIM(Vname(1,idTvar(i))) END DO #ifdef FORWARD_MIXING DO itrc=1,NBT i=idbio(itrc) # ifdef ADJOINT WRITE (out,90) ad_Akt_fac(i,ng), 'ad_Akt_fac', i, & & 'ADM basic state vertical mixing scale factor', & & 'for tracer ', i, TRIM(Vname(1,idTvar(i))) # endif # if defined TANGENT || defined TL_IOMS WRITE (out,90) tl_Akt_fac(i,ng), 'tl_Akt_fac', i, & & 'TLM basic state vertical mixing scale factor', & & 'for tracer ', i, TRIM(Vname(1,idTvar(i))) # endif END DO #endif DO itrc=1,NBT i=idbio(itrc) WRITE (out,90) Tnudg(i,ng), 'Tnudg', i, & & 'Nudging/relaxation time scale (days)', & & 'for tracer ', i, TRIM(Vname(1,idTvar(i))) END DO #ifdef TS_PSOURCE DO itrc=1,NBT i=idbio(itrc) WRITE (out,100) LtracerSrc(i,ng), 'LtracerSrc', & & i, 'Processing point sources/Sink on tracer ', i, & & TRIM(Vname(1,idTvar(i))) END DO #endif DO itrc=1,NBT i=idbio(itrc) IF (Hout(idTvar(i),ng)) WRITE (out,110) & & Hout(idTvar(i),ng), 'Hout(idTvar)', & & 'Write out tracer ', i, TRIM(Vname(1,idTvar(i))) END DO DO itrc=1,NBT i=idbio(itrc) IF (Hout(idTsur(i),ng)) WRITE (out,110) & & Hout(idTsur(i),ng), 'Hout(idTsur)', & & 'Write out tracer flux ', i, TRIM(Vname(1,idTvar(i))) END DO END IF END DO END IF ! !----------------------------------------------------------------------- ! Rescale biological tracer parameters. !----------------------------------------------------------------------- ! ! Take the square root of the biharmonic coefficients so it can ! be applied to each harmonic operator. ! DO ng=1,Ngrids DO itrc=1,NBT i=idbio(itrc) nl_tnu4(i,ng)=SQRT(ABS(nl_tnu4(i,ng))) #ifdef ADJOINT ad_tnu4(i,ng)=SQRT(ABS(ad_tnu4(i,ng))) #endif #if defined TANGENT || defined TL_IOMS tl_tnu4(i,ng)=SQRT(ABS(tl_tnu4(i,ng))) #endif ! ! Compute inverse nudging coefficients (1/s) used in various tasks. ! IF (Tnudg(i,ng).gt.0.0_r8) THEN Tnudg(i,ng)=1.0_r8/(Tnudg(i,ng)*86400.0_r8) ELSE Tnudg(i,ng)=0.0_r8 END IF END DO END DO 30 FORMAT (/,' read_BioPar - variable info not yet loaded, ', & & a,i2.2,a) 40 FORMAT (/,' read_BioPar - Error while processing line: ',/,a) 50 FORMAT (/,/,' NPZD Model Parameters, Grid: ',i2.2, & & /, ' ===============================',/) 60 FORMAT (1x,i10,2x,a,t30,a) 70 FORMAT (1p,e11.4,2x,a,t30,a) 80 FORMAT (1p,e11.4,2x,a,t30,a,/,t32,a) 90 FORMAT (1p,e11.4,2x,a,'(',i2.2,')',t30,a,/,t32,a,i2.2,':',1x,a) 100 FORMAT (10x,l1,2x,a,'(',i2.2,')',t30,a,i2.2,':',1x,a) 110 FORMAT (10x,l1,2x,a,t30,a,i2.2,':',1x,a) RETURN END SUBROUTINE read_BioPar