!================================================================
! 办肌傅庶纪滦萎士拐络丹纷换; 滦萎拇泪
!
! 97/02/22 井光赖惶
! 97/03/17 井光赖惶
!================================================================
MODULE adjust_module
USE para_module
USE rad_module
IMPLICIT NONE
PUBLIC :: dadiabat,madiabat

	CONTAINS
!----------------------------------------------------------------
SUBROUTINE dadiabat(slp,p,Ts,ptemp)		! 触羚补疤纷换

	REAL,INTENT(in)			:: slp	! 链孟山丹暗
	REAL,INTENT(in)			:: Ts	! 孟山丹补
	REAL,DIMENSION(zdim),INTENT(in) :: p	! 暗蜗
	REAL,DIMENSION(zdim),INTENT(out):: ptemp! 补疤

	ptemp = Ts * (p/slp)**(R/Cpd)

END SUBROUTINE dadiabat
!----------------------------------------------------------------
SUBROUTINE madiabat(slp,p,Ts,ptemp,xv)		! 陵碰补疤纷换

	REAL,INTENT(in)			:: slp	! 链孟山丹暗
	REAL,INTENT(in)			:: Ts	! 孟山丹补
	REAL,DIMENSION(zdim),INTENT(in)	:: p	! 暗蜗
	REAL,DIMENSION(zdim),INTENT(out):: ptemp! 补疤
	REAL,DIMENSION(zdim),INTENT(out):: xv	! 垮绝丹モル尸唯

	REAL :: xd				! 触羚络丹モル尸唯
	REAL :: msa				! 季结们钱负唯
	REAL :: dp				! 暗蜗癸
	INTEGER :: i

!-柒婶芹误

	REAL,DIMENSION(:),ALLOCATABLE :: pv	! 垮绝丹暗

	INTRINSIC EXP

!-柒婶芹误充り烧け

	ALLOCATE(pv(zdim))

!-孟山烫の掘凤肋年

	dp      = slp/(zdim-1)
	ptemp(1)= Ts
	pv(1)   = pv00 * EXP(-ql/(R*ptemp(1)))
	xv(1)   = pv(1)/p(1)
	xd      = 1.- xv(1)
	msa     = (R*ptemp(1)/(p(1)*Cpd)+(xv(1)*ql)/(xd*p(1)*Cpd))/ &
	&	(xd+xv(1)*Cpv/Cpd+(xv(1)*ql**2)/(xd*R*ptemp(1)**2*Cpd))

	ptemp(2)= ptemp(1)-dp*msa
	pv(2)   = pv00 * EXP(-ql/(R*ptemp(2)))
	xv(2)   = pv(2)/p(2)
	xd      = 1.- xv(2)

!-补疤の纷换

	DO i = 3,zdim-1
	   msa     = (R*ptemp(i-1)/(p(i-1)*Cpd)+(xv(i-1)*ql)/(xd*p(i-1)*Cpd))/&
	  &	(xd+xv(i-1)*Cpv/Cpd+(xv(i-1)*ql**2)/(xd*R*ptemp(i-1)**2*Cpd))
	   ptemp(i)= ptemp(i-2) - 2*dp*msa
   	   pv(i)   = pv00 * EXP(-ql/(R*ptemp(i)))
	   xv(i)   = pv(i)/p(i)
	   xd      = 1.- xv(i)
	END DO

	DEALLOCATE(pv)

END SUBROUTINE madiabat
!----------------------------------------------------------------
END MODULE adjust_module