!================================================================
! 一次元放射平衡大気計算; メインプログラム
!
! 97/01/25 小高正嗣
!================================================================
PROGRAM main
USE para_module
USE rad_module
IMPLICIT NONE

	INTEGER :: i
	REAL,DIMENSION(zdim) :: uf	! 上向き放射束密度
	REAL,DIMENSION(zdim) :: df	! 下向き放射束密度
	REAL,DIMENSION(zdim) :: bf	! 黒体放射束密度
	REAL,DIMENSION(zdim) :: temp	! 温度
	REAL,DIMENSION(zdim) :: p	! 圧力
	REAL,DIMENSION(zdim) :: tau	! 光学的深さ
	REAL		     :: kai	! 吸収係数(1/kg.m)
	INTEGER :: iws 				! 電脳パラメータ

	WRITE(*,*) 'INPUT ABSORPTION COEFICIENT (R) ?:'
	READ(*,*) kai

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

	tau = kai/ga*p

	bf   = 0.5*uf0*(1.5*tau + 1)
	uf   = 0.5*uf0*(1.5*tau + 2)
	df   = 0.5*uf0*1.5*tau
	temp = (bf/sig)**(0.25) 

	CALL swiset( 'IWIDTH', 400 )
	CALL swiset( 'IHEIGHT', 700 )
!	CALL swiset( 'IWIDTH', 700 )
!	CALL swiset( 'IHEIGHT', 400 )
        CALL sglset( 'LCORNER', .FALSE. )
	WRITE(*,*) 'WORKSTATION ID (I) ?;'
	CALL sgpwsn
	READ(*,*) iws
	CALL gropn( iws )
	CALL sldiv( 'T',1, 2 )

	CALL dclfig(p,tau,bf,uf,df,temp)

	CALL get_urf1(tau,temp,uf)
	CALL get_drf1(tau,temp,df)

	CALL dclfig(p,tau,bf,uf,df,temp)

	CALL get_urf2(tau,temp,uf)
	CALL get_drf2(tau,temp,df)

	CALL dclfig(p,tau,bf,uf,df,temp)

	CALL grcls

	WRITE(*,*) 'END PROGRAM'

	CONTAINS
!----------------------------------------------------------------------
SUBROUTINE dclfig(p,tau,bf,uf,df,temp)

	REAL,DIMENSION(zdim),INTENT(in) :: uf	! 上向き放射束密度
	REAL,DIMENSION(zdim),INTENT(in) :: df	! 下向き放射束密度
	REAL,DIMENSION(zdim),INTENT(in) :: bf	! 黒体放射束密度
	REAL,DIMENSION(zdim),INTENT(in) :: temp	! 温度
	REAL,DIMENSION(zdim),INTENT(in) :: p	! 圧力
	REAL,DIMENSION(zdim),INTENT(in) :: tau	! 光学的深さ


	REAL :: taub 				! 光学的深さ

	taub = tau(1)


	CALL grfrm

	CALL grswnd( 0., uf(1)+100., taub, 0. )
	CALL grsvpt( 0.2, 0.8, 0.2, 0.8 )
	CALL grstrn( 1 )
	CALL grstrf
	CALL usdaxs
	CALL uxsttl( 'B', 'flux (W/m^2)', 0. )
	CALL uysttl( 'L', 'optical depth', 0. )
	CALL uulin( zdim, uf, tau )
	CALL uuslnt(3)
	CALL uulin( zdim, df, tau )
	CALL uuslnt(1)
	CALL uuslni(2)
	CALL uulin( zdim, bf, tau )

	CALL grfrm
	CALL grswnd( 0., temp(1)+100., slp, 100. )
	CALL grsvpt( 0.2, 0.8, 0.2, 0.8 )
	CALL grstrn( 2 )
	CALL grstrf
	CALL usdaxs
	CALL uxsttl( 'B', 'temperature (K)', 0. )
	CALL uysttl( 'L', 'pressure (Pa)', 0. )
	CALL uuslni(1)
	CALL uulin( zdim-1, temp, p )



END SUBROUTINE dclfig
!----------------------------------------------------------------------
END PROGRAM main



