c
c
c
module everywhere
c
c This module will declare all variables that will be common to all
c components of this program
c
implicit none
c
real, allocatable :: valley(:),hip(:),rafters(:)
real, allocatable :: valley2(:),hip2(:),rafters2(:)
real, allocatable :: angleh(:),angler(:),anglev(:)
c
integer n1,n2,n3
c
c This program was written by Jason Wehr on October 5, 1996
c The purpose of this program is to take a given roof pitch and turn it intc its equivalent degree representation for both the main roof and for hip
c and valley rafters.
c
c
c
c valley = the array valley will contain the number of valleys that have a
c different slope
c
c hip = the array hip will contain the number of hip rafters that have a
c different slope
c
c rafters = the array rafters will contain the number of different sloping
c rafters on the roof
c
c n1 = this will allocate the number of spaces need by the array valley
c
c n2 = this will allocate the number of elements needed by the array hip
c
c n3 = this will allocate the number of elements needed by the array rafterc
c The three arrays, valley2, hip2, and rafters2 will be used to store the
c pitch of the roof divided by twelve
c
end module everywhere
c
program roof
use everywhere
implicit none
integer i,k
real h_v_angle
c
c integer i will be used in do loops later in the program. integer k is
c used in the open statement for the ouptfile as the iostat= argument.
c Finally h_v_angle is a function designed to get the value of the tangent
c of the hip and valley rafters.
c
120 call get_elements
c
c The subroutine get_elements will prompt the user for the number of
c different slopes that are needed for each kind of rafter
c
c
if (n3.gt.0) then
allocate (rafters(1:n3),angler(1:n3),rafters2(1:n3))
else if (n3.le.0) then
print *, 'You have no roof. Please input again.'
go to 120
c
end if
c
if (n1.gt.0) then
allocate (valley(1:n1),anglev(1:n1),valley2(1:n1))
end if
if (n2.gt.0) then
allocate (hip(1:n2),angleh(1:n2),hip2(1:n2))
end if
call pitch
c
c The subroutine pitch picks up the value of rise on the roof
c
c I also need to open a file to output my results to
c
open(unit=14,file='pitch.out',status='unknown',iostat=k,err=100)
c
c Now The angles for all the different rafter slopes will be calculated
c
if (n1.ge.1) then
do i=1,n1
valley2(i)=h_v_angle(valley(i))
c
anglev(i)=atan(valley2(i))
c
end do
end if
c
if (n2.ge.1) then
do i=1,n2
hip2(i)=h_v_angle(hip(i))
angleh(i)=atan(hip2(i))
end do
end if
c
do i=1,n3
rafters2(i)=rafters(i)/12.0
angler(i)=atan(rafters2(i))
end do
c
c Now it is time to issue a call to a subroutine that will out put the bothc the pitch of the roof as will as that pitches corresponding angle.
c
call output
100 if (k.gt.0) then
print *, "Error occured in opening file. iostat = ",k
end if
close (14)
c
stop
c
end
c
subroutine get_elements
c
c This subroutine will prompt the user for the number of different rafters
c of each type.
c
use everywhere
implicit none
write (*,*) "How many regular rafters are there of different",
& " slopes?"
read *, n3
write (*,*) "How many different sloping hip rafters will",
& " there be?"
read *, n2
write (*,*) "How many different valleys will there be?"
read *, n1
c
return
c
end
c
subroutine pitch
c
use everywhere
implicit none
c
c The subroutine pitch will prompt the user for the rise of the roof
c slope for all the different slopes of each type of rafter.
c
integer j,k,n,i
do i=1,n3
if (i.eq.1) then
write (*,*) "Please give me the number ",i," value of the",
& " rafter rise. For example, if it is a four on",
& " twelve,type 4.0."
read *, rafters(i)
end if
if (i.gt.1) then
write (*,*) "Please give me the number ",i," value of the",
& " rafter rise."
read *, rafters(i)
end if
end do
if (n2.gt.0) then
do j=1,n2
if (j.eq.1) then
write (*,*) "Please give me the number ",j," value of the ",
& "pitch of the two roofs that come ",
& "together at the hip. For example, if the pitch ",
& "is a four on twelve,then type 4.0."
read *, hip(j)
end if
if (j.gt.1) then
write (*,*) "Please give me the number ",j," value of the ",
& "pitch of the the two roofs that come together ",
& "at the hip."
read *, hip(j)
end if
end do
end if
if (n1.gt.0) then
do k=1,n1
if(k.eq.1) then
write (*,*) "Please give me the number ",k,"value of the ",
& "pitch of the two roofs that come together ",
& "at the valley. For example, if the the value of ",
& "the pitch is a four on twelve, then type 4.0."
read *, valley(k)
end if
if(k.gt.1) then
write (*,*) "Please give the the number ",k," value of ",
& "the pitch of the two roofs that come ",
& "together at the valley."
read *, valley(k)
end if
end do
end if
return
end
c
function h_v_angle(x)
c
c
c This function is used to convert the value of pitch of the two roofs
c that come together at a hip or valley and convert it into the true pitch
c of those rafters.
c
implicit none
real h_v_angle,x,factor
factor = 288.0
factor = sqrt(factor)
h_v_angle=x/factor
return
end
c
c
subroutine output
c
use everywhere
implicit none
integer j
real frad
character*7 word1*18,word2*19,word3*9,word4*3,word5,word6
character*3 word7
c
c when a the function frad is called in this program, it is converting
c the value of the computed angles from radians to degrees.
c
word1 = 'Pitch of adjoining'
word2 = 'corresponding angle'
word3 = 'roofs at '
word4 = 'of '
word5 = ' rafter'
word6 = 'valleys'
word7 = 'hip'
print *, "Answers are in the file pitch.out"
if (n1.gt.0) then
write (14,'(5x,a18,5x,a19)') word1,word2
write (14,2000) word3//word6,word4//word6(1:6)//word5
do j=1,n1
write (14,*)
anglev(j)=frad(anglev(j))
write(14,'(2x,i2,10x,f5.2,16x,f5.2)') j,valley(j),anglev(j)
end do
end if
if (n2.gt.0) then
write (14,*)
write (14,'(5x,a18,5x,a19)') word1,word2
write (14,2011) word3//word7,word4//word7//word5
do j=1,n2
write (14,*)
angleh(j)=frad(angleh(j))
write(14,'(2x,i2,10x,f5.2,16x,f5.2)') j,hip(j),angleh(j)
end do
end if
write (14,*)
write (14,'(5x,a15,8x,a19)') word1(1:8)//word5,word2
write (14,'(28x,a10)') word4//word5
do j=1,n3
write(14,*)
angler(j)=frad(angler(j))
write(14,'(2x,i2,tr10,f5.2,tr16,f5.2)') j,rafters(j),angler(j)
end do
2000 format (5x,a16,7x,a16)
2011 format (5x,a12,11x,a16)
return
end
c
function frad(x)
c
c This function converts from raidians to degrees
c
use everywhere
implicit none
real frad,x,factor,pi
parameter (pi=3.1415927)
parameter (factor=180/pi)
frad = x*factor
return
end
c
c
c