!================================================================
! 一次元放射対流平衡大気計算; 座標設定
!
! 97/03/17 小高正嗣
!================================================================
MODULE cod_module
USE para_module
IMPLICIT NONE
PUBLIC :: set_mprs,set_dprs,set_mtau,set_dtau

	CONTAINS
!----------------------------------------------------------------
SUBROUTINE set_mprs(Ts,slp,p)	! 湿潤大気の圧力座標

	REAL,INTENT(in)			:: Ts	! 地表気温
	REAL,INTENT(out) 		:: slp	! 全地表気圧
	REAL,DIMENSION(zdim),INTENT(out):: p	! 全圧力
	INTEGER				:: i

	slp = Ps + pv00*EXP(-ql/(R*Ts))

	DO i=1,zdim
	   p(i) = slp/(zdim-1)*(zdim-i)
	END DO

END SUBROUTINE set_mprs
!----------------------------------------------------------------
SUBROUTINE set_dprs(slp,p)	! 乾燥大気の圧力座標

	REAL,INTENT(out)		:: slp	! 全地表気圧
	REAL,DIMENSION(zdim),INTENT(out):: p	! 全圧力
	INTEGER				:: i

	slp = Ps

	DO i=1,zdim
	   p(i) = slp/(zdim-1)*(zdim-i)
	END DO

END SUBROUTINE set_dprs
!----------------------------------------------------------------
SUBROUTINE set_mtau(p,xv,tau)	! 湿潤大気の光学的厚さの計算

!	INTEGER,INTENT(in)		:: dim	! 配列次元
	REAL,DIMENSION(:),INTENT(in)	:: p	! 圧力
	REAL,DIMENSION(:),INTENT(in)	:: xv	! 水蒸気モル分率
	REAL,DIMENSION(:),INTENT(out)	:: tau	! 光学的深さ
	REAL,DIMENSION(:),ALLOCATABLE	:: xd	! 乾燥大気モル分率
	REAL,DIMENSION(:),ALLOCATABLE	:: Mm	! 平均分子量

	ALLOCATE(xd(SIZE(p)))
	ALLOCATE(Mm(SIZE(p)))

	xd  = 1.- xv
	Mm  = Mr*xd + Mv*xv
	tau = (kaiv*Mv*xv + kaid*Mr*xd)*p/(ga*Mm)

	DEALLOCATE(xd,Mm)

END SUBROUTINE set_mtau
!----------------------------------------------------------------
SUBROUTINE set_dtau(p,tau)	! 乾燥大気の光学的厚さの計算

!	INTEGER,INTENT(in)		:: dim	! 配列次元
	REAL,DIMENSION(:),INTENT(in)	:: p	! 圧力
	REAL,DIMENSION(:),INTENT(out)	:: tau	! 光学的深さ

	tau   = kaid*p/ga

END SUBROUTINE set_dtau
!----------------------------------------------------------------
SUBROUTINE set_xv(i,pxv,xv)	! 水蒸気モル分率の計算

	INTEGER,INTENT(in)		:: i	! 圏界面高度番号
	REAL,DIMENSION(zdim),INTENT(in)	:: pxv	! 水蒸気モル分率(仮値)
	REAL,DIMENSION(zdim),INTENT(out):: xv	! 水蒸気モル分率

	xv(1:i)      = pxv(1:i)
	IF ( i /= zdim ) THEN
	  xv(i+1:zdim) = pxv(i)
	END IF

END SUBROUTINE set_xv
!----------------------------------------------------------------
END MODULE cod_module