subroutine output c include 'common_blocks.h' c real*8 dout,bioi(nbio),depth,totpp,totN,totZ,nozero(nbio) real*8 Dflux(500),TavgD400(500) real*8 davg1,davg2,davg3,davg4,ST1,ST2,ST3,ST4 character*4 sv(nbiotot),hdr(nbiotot) character*8 hdrunit(nbiotot) tms=24.d0 cc 4-component example: sv(1)='Phyt' sv(2)='Zoop' sv(3)='DetN' sv(4)='Nitr' cc 8-component example: c sv(1)='PhSm' c sv(2)='PhLg' c sv(3)='ZoSm' c sv(4)='ZoLg' c sv(5)='DnSm' c sv(6)='DnLg' c sv(7)='Nitr' c sv(8)='Ammo' cc Enter 4-digit ecosystem-specific column headers: c sv(1)='' c sv(2)='' c sv(3)='' c sv(4)='' c sv(5)='' c sv(6)='' c sv(7)='' c sv(8)='' c sv(9)='' c sv(10)='' c sv(11)='' c sv(12)='' c sv(13)='' c sv(14)='' c sv(15)='' c sv(16)='' c sv(17)='' c sv(18)='' c sv(19)='' c sv(20)='' c sv(21)='' c sv(22)='' c sv(23)='' c sv(24)='' c sv(25)='' c sv(26)='' c sv(27)='' c sv(28)='' c sv(29)='' c sv(30)='' c cccccc CREATE OUTPUT FILES: MODEL EQUIVALENTS OF DATA FILES cccccccccccc c if(ntb.eq.1) then open(unit=91,file=homedir//'PrPr_as.out') open(unit=92,file=homedir//'Z_as.out') open(unit=93,file=homedir//'P_as.out') open(unit=94,file=homedir//'N_as.out') open(unit=95,file=homedir//'ST_as.out') elseif(ntb.eq.2) then open(unit=91,file=homedir//'PrPr_ep.out') open(unit=92,file=homedir//'Z_ep.out') open(unit=93,file=homedir//'P_ep.out') open(unit=94,file=homedir//'N_ep.out') open(unit=95,file=homedir//'ST_ep.out') endif ntcount=1 do jmain=1,isteps do n=1,nz if(dayPrPr(ntcount).ge.cdays(jmain). & and.dayPrPr(ntcount).lt.cdays(jmain+1)) then if(zPrPr(ntcount).ge.dz*(real(n)-1.d0). & and.zPrPr(ntcount).lt.(dz*real(n)))then totpp=0.d0 do ii=1,24 totpp=totpp+bio(n,jmain+ii-12,ipp) enddo write(91,*)dayPrPr(ntcount),zPrPr(ntcount),totpp ntcount=ntcount+1 endif endif enddo enddo ntcount=1 do jmain=1,isteps do n=1,nz if(dayZ(ntcount).ge.cdays(jmain). & and.dayZ(ntcount).lt.cdays(jmain+1)) then if(zZ(ntcount).ge.dz*(real(n)-1.d0). & and.zZ(ntcount).lt.(dz*real(n)))then totZ=0.d0 do inb=1,nsv if(Cnsv(inb).eq.2) & totZ=totZ+bio(n,jmain,inb)*unitnsv(inb) enddo write(92,*)dayZ(ntcount),zZ(ntcount),totZ ntcount=ntcount+1 endif endif enddo enddo ntcount=1 do jmain=1,isteps do n=1,nz if(dayChl(ntcount).ge.cdays(jmain). & and.dayChl(ntcount).lt.cdays(jmain+1)) then if(zChl(ntcount).ge.dz*(real(n)-1.d0). & and.zChl(ntcount).lt.(dz*real(n)))then write(93,*)dayChl(ntcount),zChl(ntcount), & bio(n,jmain,ichl) ntcount=ntcount+1 endif endif enddo enddo ntcount=1 do jmain=1,isteps do n=1,nz if(dayN(ntcount).ge.cdays(jmain). & and.dayN(ntcount).lt.cdays(jmain+1)) then if(zN(ntcount).ge.dz*(real(n)-1.d0). & and.zN(ntcount).lt.(dz*real(n))) then totN=0.d0 do inb=1,nsv if(Cnsv(inb).eq.1) & totN=totN+bio(n,jmain,inb)*unitnsv(inb) enddo write(94,*)dayN(ntcount),zN(ntcount),totN ntcount=ntcount+1 endif endif enddo enddo c ccccccc COMPUTE model equivalents of SED FLUX cccccccccccccccc c if(ntb.eq.1) then do nscount=1,nSTdat Dflux(nscount)=0.d0 enddo nscount=1 do jmain=1,isteps if(dayST(nscount).ge.cdays(jmain). & and.dayST(nscount).lt.cdays(jmain+1)) then do inb=1,nsv if(Cnsv(inb).eq.3.) then tmpD400=0.d0 do nt=1,nint(timeST(nscount)*tms) tmpD400=tmpD400+bio(nz,jmain+nt-1,inb) & *unitnsv(inb) enddo TavgD400(nscount)=14.d0* & tmpD400/(real(nint(timeST(nscount)*tms))) Dflux(nscount)=Dflux(nscount)+ & wnsv(inb)*TavgD400(nscount)* & dexp((-zST(nscount)+real(nz*dz))* & reminrate/wnsv(inb)) endif enddo write(95,*)dayST(nscount)+STlag,zST(nscount), & timeST(nscount),Dflux(nscount) nscount=nscount+1 endif enddo elseif(ntb.eq.2) then davg1=0.d0 davg2=0.d0 davg3=0.d0 davg4=0.d0 c Shallow EqPac trap data (units mmolC/m2/day) ST1=5.3d0 ST2=6.7d0 ST3=12.1d0 ST4=12.8d0 do inb=1,nsv if(Cnsv(inb).eq.3) then do j=2784,2784+30*24-1 davg1=davg1+bio(12,j,inb)*wnsv(inb) & *(117./16.)*unitnsv(inb) enddo endif enddo davg1=davg1/(24.*30.) do inb=1,nsv if(Cnsv(inb).eq.3) then do j=3648,3648+30*24-1 davg2=davg2+bio(12,j,inb)*wnsv(inb) & *(117./16.)*unitnsv(inb) enddo endif enddo davg2=davg2/(24.*30.) do inb=1,nsv if(Cnsv(inb).eq.3) then do j=7248,7248+30*24-1 davg3=davg3+bio(12,j,inb)*wnsv(inb) & *(117./16.)*unitnsv(inb) enddo endif enddo davg3=davg3/(24.*30.) do inb=1,nsv if(Cnsv(inb).eq.3) then do j=8280,8280+30*24-1 davg4=davg4+bio(12,j,inb)*wnsv(inb) & *(117./16.)*unitnsv(inb) enddo endif enddo davg4=davg4/(24.*30.) write(95,*)' 404.00 ',sngl(davg1) write(95,*)' 440.00 ',sngl(davg2) write(95,*)' 590.00 ',sngl(davg3) write(95,*)' 633.00 ',sngl(davg4) endif c close(91) close(92) close(93) close(94) close(95) c c CREATE FORWARD MODEL OUTPUT FILE c if(ntb.eq.1) then open(unit=8,file=homedir//'Vprof_ArabSea.out') open(unit=26,file=homedir//'Vavg_ArabSea.out') elseif(ntb.eq.2) then open(unit=8,file=homedir//'Vprof_EqPac.out') open(unit=26,file=homedir//'Vavg_EqPac.out') endif dout = 1.d0 ! output interval (days) m=0 do inb=1,nsv if(Cnsv(inb).ne.0) then nozero(m+1)=inb m=m+1 endif enddo nzT=m c sv(nbio-1)='Chla' c sv(nbio)='PrPr' m=1 do inb=1,nsv if(Cnsv(inb).ne.0.)then hdr(m)=sv(inb) if(Cnsv(inb).eq.1.)hdrunit(m)='mmolN/m3' if(Cnsv(inb).eq.2.)hdrunit(m)='mmolC/m3' if(Cnsv(inb).eq.3.)hdrunit(m)='mmolN/m3' m=m+1 endif enddo hdr(m)='Chla' hdr(m+1)='PrPr' hdrunit(m)='mgChl/m3' hdrunit(m+1)='mgC/m3/d' mmax=m+1 write(8,201)'day','depth',(hdr(m),m=1,mmax) write(8,202)' ',' m ',(hdrunit(m),m=1,mmax) write(26,101)'day','Total N','Total Z','Total Dn','Chl','PP' write(26,102)'mmolN/m2','mmolC/m2','mmolN/m2', & 'mgChl/m2','mgC/m2/d' c do jmain=2,isteps if(mod(cdays(jmain),dout).lt..00002d0) then do m = 1,5 bioi(m) = 0.d0 enddo do n = 1,nz do inb=1,nsv if(Cnsv(inb).ne.0) & bioi(Cnsv(inb))=bioi(Cnsv(inb)) & +bio(n,jmain,inb)*unitnsv(inb)*dz enddo bioi(4)=bioi(4)+bio(n,jmain,ichl)*dz totpp=0.d0 do ii=1,24 totpp=totpp+bio(n,jmain+ii-12,ipp) enddo bioi(5)=bioi(5)+totpp*dz depth = real(n*dz)-dz/2.d0 write(8,200) cdays(jmain),depth, & (bio(n,jmain,nozero(m))*unitnsv(nozero(m)), & m=1,nzT),bio(n,jmain,ichl),totpp enddo write(26,100)cdays(jmain),(bioi(m),m=1,5) endif enddo 100 format(1(f5.1,1x),25(f9.3,1x)) 101 format(1(a4,2x),3(a8,3x),2(a5,3x)) 102 format(6x,2(a9,2x),3(a8,2x)) 200 format(2(f5.1,1x),25(f8.3,1x)) 201 format(a4,2x,a5,4x,25(a4,5x)) 202 format(a4,2x,a5,3x,25(a8,1x)) close(8) close(26) c return end