!================================================================
! 办肌傅庶纪滦萎士拐络丹纷换; 郝筛肋年
!
! 97/03/17 井光赖惶
! 97/05/08 井光赖惶
! 97/06/22 井光赖惶
!================================================================
MODULE cod_module
USE para_module
IMPLICIT NONE
PUBLIC :: set_mprs,set_dprs,set_mtau,set_dtau

	CONTAINS
!----------------------------------------------------------------
SUBROUTINE set_mprs( dpln, slp, p )	! 季结络丹の暗蜗郝筛

	REAL,INTENT(in)			:: dpln	! 暗蜗癸み(log)
	REAL,INTENT(in) 		:: slp	! 链孟山丹暗
	REAL,DIMENSION(0:),INTENT(out)	:: p	! 链暗蜗
	INTEGER				:: i

	DO i=1,SIZE(p)-2
	   p(i) = slp * EXP( -dpln*(i-1) )
	END DO
	p(0) = p(1)
	p(SIZE(p)-1) = p(SIZE(p)-2)

END SUBROUTINE set_mprs
!----------------------------------------------------------------
SUBROUTINE set_dprs( dpln, slp, p )	! 触羚络丹の暗蜗郝筛

	REAL,INTENT(in)			:: dpln	! 暗蜗癸み(log)
	REAL,INTENT(in)			:: slp	! 链孟山丹暗
	REAL,DIMENSION(0:),INTENT(out)	:: p	! 链暗蜗

	INTEGER				:: i

	DO i=1,SIZE(p)-2
	   p(i) = slp * EXP( -dpln*(i-1) )
	END DO
	p(0) = p(1)
	p(SIZE(p)-1) = p(SIZE(p)-2)

END SUBROUTINE set_dprs
!----------------------------------------------------------------
SUBROUTINE set_mtau( p, xv, tau )	! 季结络丹の各池弄更さの纷换

	REAL,DIMENSION(:),INTENT(in)	:: p	! 暗蜗
	REAL,DIMENSION(:),INTENT(in)	:: xv	! 垮绝丹モル尸唯
	REAL,DIMENSION(:),INTENT(out)	:: tau	! 各池弄考さ

	REAL	:: xd				! 触羚络丹モル尸唯
	REAL	:: Mm				! 士堆尸灰翁
	REAL	:: dp				! 暗蜗癸
	REAL	:: deltau1,deltau2		! 各池弄更さ癸
	INTEGER	:: i
	REAL	:: kaid			! 润杜冯喇尸帝箭犯眶(1/kg.m)

	OPEN(10,file='kaid.dat')
	READ(10,*) kaid
	CLOSE(10)

	xd  = 1.- xv(SIZE(p))
	Mm  = Mr*xd + Mv*xv(SIZE(p))

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

	DO i = SIZE(p)-2,1,-1
	   dp = p(i) - p(i+1)

	   CALL get_deltau( xv(i+1), deltau1 )
	   CALL get_deltau( xv(i), deltau2 )

	   tau(i) = tau(i+1) + ( deltau1 + deltau2 )/2.
	END DO

	CONTAINS
!----------------------------------------------------------------
	SUBROUTINE get_deltau( xv, deltau )

	REAL,INTENT(in)	:: xv		! 垮绝丹モル尸唯
	REAL,INTENT(out):: deltau	! 各池弄更さ笼尸
	REAL		:: xd		! 触羚络丹モル尸唯
	REAL		:: Mm		! 士堆尸灰翁

	xd = 1.-xv
	Mm = Mr*xd + Mv*xv

	deltau = dp * ( kaiv*Mv*xv + kaid*Mr*xd )/( ga*Mm )

	END SUBROUTINE get_deltau
!----------------------------------------------------------------
END SUBROUTINE set_mtau
!----------------------------------------------------------------
SUBROUTINE set_dtau( p, tau )	! 触羚络丹の各池弄更さの纷换

	REAL,DIMENSION(:),INTENT(in)	:: p	! 暗蜗
	REAL,DIMENSION(:),INTENT(out)	:: tau	! 各池弄考さ
	REAL	:: kaid			! 润杜冯喇尸帝箭犯眶(1/kg.m)

	OPEN(10,file='kaid.dat')
	READ(10,*) kaid
	CLOSE(10)

	tau   = kaid*p/ga

END SUBROUTINE set_dtau
!----------------------------------------------------------------
SUBROUTINE set_xv( i, pxv, xv )	! 垮绝丹モル尸唯の纷换

	INTEGER,INTENT(in)		:: i	! 拂肠烫光刨戎规
	REAL,DIMENSION(0:),INTENT(in)	:: pxv	! 垮绝丹モル尸唯(簿猛)
	REAL,DIMENSION(0:),INTENT(out)	:: xv	! 垮绝丹モル尸唯

	xv(0:i)  = pxv(0:i)
	xv(i+1:) = pxv(i)

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