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 cc c