!================================================================ ! 一次元放射対流平衡大気計算; 放射計算 ! ! 97/02/23 小高正嗣 ! 97/03/12 小高正嗣; 修正 ! 97/03/17 小高正嗣 ! 97/05/04 小高正嗣; 修正 !================================================================ MODULE rad_module USE para_module IMPLICIT NONE PUBLIC :: get_bbf,get_urf1,get_drf1,get_urf,get_drf,rdeqiv, & get_fnet,get_cvf CONTAINS !---------------------------------------------------------------- SUBROUTINE get_bbf(temp,bf) ! 黒体放射束密度の計算 REAL,DIMENSION(:),INTENT(in) :: temp ! 温度 REAL,DIMENSION(:),INTENT(out) :: bf ! 黒体放射束密度 bf = sig*temp**4 END SUBROUTINE get_bbf !---------------------------------------------------------------- SUBROUTINE get_urf1(nu,tau,temp,uf) ! 上向き放射束密度の計算 INTEGER,INTENT(in) :: nu ! 大気層番号 REAL,DIMENSION(:),INTENT(in) :: tau ! 光学的深さ REAL,DIMENSION(:),INTENT(in) :: temp ! 温度 REAL,DIMENSION(:),INTENT(out) :: uf ! 上向き放射束密度 REAL,DIMENSION(:),ALLOCATABLE :: bf ! 黒体放射束密度 INTEGER i ALLOCATE(bf(SIZE(tau))) CALL get_bbf(temp,bf) uf = bf(1)*EXP(3*(tau(nu)-tau(1))/2) DO i = 2,nu ! uf(nu) = uf(nu) & ! + 3/2*bf(i)*EXP(-3*(tau(i)-tau(nu))/2)*(tau(i-1)-tau(i)) uf(nu) = uf(nu) & - bf(i)*(EXP(-3*(tau(i-1)-tau(nu))/2) & -EXP(-3*(tau(i+1)-tau(nu))/2)) END DO DEALLOCATE(bf) END SUBROUTINE get_urf1 !---------------------------------------------------------------- SUBROUTINE get_urf(tau,temp,uf) ! 全層での上向き放射束密度の計算 REAL,DIMENSION(:),INTENT(in) :: tau ! 光学的深さ REAL,DIMENSION(:),INTENT(in) :: temp ! 温度 REAL,DIMENSION(:),INTENT(out) :: uf ! 上向き放射束密度 REAL,DIMENSION(:),ALLOCATABLE :: bf ! 黒体放射束密度 INTEGER i,j,zdim zdim = SIZE(tau) ALLOCATE(bf(zdim)) CALL get_bbf(temp,bf) uf = bf(1)*EXP(3*(tau-tau(1))/2) DO i = 2,zdim-1 DO j = 2,i ! uf(i) = uf(i) & ! + 3/2*bf(j)*EXP(-3*(tau(j)-tau(i))/2)*(tau(j-1)-tau(j)) uf(i) = uf(i) & - bf(j)*(EXP(-3*(tau(j-1)-tau(i))/2) & -EXP(-3*(tau(j+1)-tau(i))/2)) END DO END DO DO i = 2,zdim-1 uf(zdim) = uf(zdim) & - bf(zdim)*(EXP(-3*(tau(i-1)-tau(zdim))/2) & -EXP(-3*(tau(i+1)-tau(zdim))/2)) END DO uf(zdim) = uf(zdim) & - bf(zdim)*(EXP(-3*(tau(i-1)-tau(zdim))/2)-1.) DEALLOCATE(bf) END SUBROUTINE get_urf !---------------------------------------------------------------- SUBROUTINE get_drf1(nu,tau,temp,df) ! 下向き放射束密度の計算 INTEGER,INTENT(in) :: nu ! 大気層番号 REAL,DIMENSION(:),INTENT(in) :: tau ! 光学的深さ REAL,DIMENSION(:),INTENT(in) :: temp ! 温度 REAL,DIMENSION(:),INTENT(out) :: df ! 下向き放射束密度 REAL,DIMENSION(:),ALLOCATABLE :: bf ! 黒体放射束密度 INTEGER i,zdim zdim =SIZE(tau) ALLOCATE(bf(zdim)) CALL get_bbf(temp,bf) df = 0. DO i = nu+1,zdim-1 ! DO i = nu+1,zdim ! df(nu) = df(nu) & ! + 3/2*bf(i)*EXP(-3*(tau(nu)-tau(i))/2)*(tau(i-1)-tau(i)) df(nu) = df(nu) & + bf(i)*(EXP(-3*(tau(nu)-tau(i-1))/2) & - EXP(-3*(tau(nu)-tau(i+1))/2)) END DO df(nu) = df(nu) & + bf(zdim)*(EXP(-3*(tau(nu)-tau(zdim-1))/2) & - EXP(-3*(tau(nu)-tau(zdim))/2)) DEALLOCATE(bf) END SUBROUTINE get_drf1 !---------------------------------------------------------------- SUBROUTINE get_drf(tau,temp,df) ! 全層での下向き放射束密度の計算 REAL,DIMENSION(:),INTENT(in) :: tau ! 光学的深さ REAL,DIMENSION(:),INTENT(in) :: temp ! 温度 REAL,DIMENSION(:),INTENT(out) :: df ! 下向き放射束密度 REAL,DIMENSION(:),ALLOCATABLE :: bf ! 黒体放射束密度 INTEGER i,j,zdim zdim = SIZE(tau) ALLOCATE(bf(zdim)) CALL get_bbf(temp,bf) df = 0. DO i = 1,zdim-1 ! DO j = i+1,zdim-1 DO j = i+1,zdim-1 ! df(i) = df(i) & ! + 3/2*bf(j)*EXP(-3*(tau(i)-tau(j))/2)*(tau(j-1)-tau(j)) df(i) = df(i) & + bf(j)*(EXP(-3*(tau(i)-tau(j-1))/2) & - EXP(-3*(tau(i)-tau(j+1))/2)) END DO df(i) = df(i) & + bf(zdim)*(EXP(-3*(tau(i)-tau(zdim-1))/2) & - EXP(-3*(tau(i)-tau(zdim))/2)) END DO DEALLOCATE(bf) END SUBROUTINE get_drf !---------------------------------------------------------------- SUBROUTINE get_cvf(uf,df,sf,cf) ! 対流熱流速密度の計算 REAL,DIMENSION(:),INTENT(in) :: uf ! 上向き射束密度 REAL,DIMENSION(:),INTENT(in) :: df ! 下向き射束密度 REAL,DIMENSION(:),INTENT(in) :: sf ! 太陽放射束密度 REAL,DIMENSION(:),INTENT(out) :: cf ! 対流熱流束密度 cf = df + sf - uf END SUBROUTINE get_cvf !---------------------------------------------------------------- SUBROUTINE get_fnet(uf,df,Fnet) ! 正味放射束密度の計算 REAL,DIMENSION(:),INTENT(in) :: uf ! 上向き射束密度 REAL,DIMENSION(:),INTENT(in) :: df ! 下向き射束密度 REAL,DIMENSION(:),INTENT(out) :: Fnet ! 正味上向き放射束密度 Fnet = uf - df END SUBROUTINE get_fnet !---------------------------------------------------------------- SUBROUTINE rdeqiv(bn,tau,bf,temp,uf0) ! 放射平衡解の計算 INTEGER,INTENT(in) :: bn ! 成層圏下端高度番号 REAL,DIMENSION(:),INTENT(in) :: tau ! 光学的厚さ REAL,DIMENSION(:),INTENT(inout) :: bf ! 黒体放射束密度 REAL,DIMENSION(:),INTENT(inout) :: temp ! 温度 REAL,INTENT(out) :: uf0 ! 大気上端上向き放射束密度 !-大気上端上向き放射束密度の計算 uf0 = 2*sig*temp(bn)**4/(1.5*tau(bn)+1) !-成層圏の温度; 放射平衡解 bf(bn+1:) = 0.5*uf0*(1.5*tau(bn+1:) + 1) temp(bn+1:) = (bf(bn+1:)/sig)**(0.25) END SUBROUTINE rdeqiv !---------------------------------------------------------------- END MODULE rad_module