! subroutine column use params,only: nlev use flds_col,only: cno2,cno,cnn2 use flds_atmos,only: tn use flds_modelz,only: gz, zqht use flds_atmos,only: xno2,xnn2,xno implicit none ! ! Local: real :: shtcp,alp1,alp2,alp3 integer :: k,k1 integer :: nlevm1=nlev-1 ! ! Slant column number densities for major species: ! shtcp=1.38e-16*tn(nlev)/(1.66e-24*gz(nlev)) cno2(nlev) = xno2(nlev)*shtcp/32. cno(nlev) = xno (nlev)*shtcp/16. cnn2(nlev) = xnn2(nlev)*shtcp/28. do k=nlevm1,1,-1 k1=k+1 alp1 = alog(xno2(k1)/xno2(k))/(zqht(k1)-zqht(k)) alp2 = alog(xno (k1)/xno (k))/(zqht(k1)-zqht(k)) alp3 = alog(xnn2(k1)/xnn2(k))/(zqht(k1)-zqht(k)) cno2(k)=cno2(k1)+xno2(k)*(exp(alp1*(zqht(k1)-zqht(k)))-1.)/alp1 cnn2(k)=cnn2(k1)+xnn2(k)*(exp(alp3*(zqht(k1)-zqht(k)))-1.)/alp3 if (abs(alp2) < 1.e-10) then cno(k)=cno(k1)+xno(k)*(zqht(k1)-zqht(k)) else cno(k)=cno(k1)+xno(k)*(exp(alp2*(zqht(k1)-zqht(k)))-1.)/alp2 endif enddo ! k=nlevm1,1,-1 end subroutine column !----------------------------------------------------------------------- subroutine colum(xmlw,xxn,col) use params,only: nlev use flds_modelz,only: gz, zqht use flds_atmos,only: tn implicit none ! ! Args: real,intent(in) :: xmlw,xxn(nlev) real,intent(out) :: col(nlev) ! ! Local: integer :: k,k1 integer :: nlevm1=nlev-1 real :: shtx,alp ! shtx=1.38e-16*tn(nlev)/(1.66e-24*gz(nlev)) col(nlev) = xxn(nlev)*shtx/xmlw do k=nlevm1,1,-1 k1=k+1 alp=alog(xxn(k1)/xxn(k))/(zqht(k1)-zqht(k)) if (abs(alp) < 1.e-10) then col(k)=col(k1)+xxn(k)*(zqht(k1)-zqht(k)) else col(k)=col(k1)+xxn(k)*(exp(alp*(zqht(k1)-zqht(k)))-1.)/alp endif enddo end subroutine colum