Advertisement
Guest User

Untitled

a guest
Feb 28th, 2019
93
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.       function f(x, y)
  2.       f = 1/(x+y)
  3.       end
  4.      
  5.       program main
  6.       common /values/ x1, x2, y1, y2, hx, hy
  7.      
  8.       call input
  9.       call output
  10.       write (*,*) 'OK'
  11.      
  12.       pause
  13.       end
  14.  
  15.       subroutine input
  16.       character*20 msg
  17.       common /values/ x1, x2, y1, y2, hx, hy
  18.       open(1, file = 'input.txt')
  19.       read(1,*) x1, x2, hx
  20.       read(1,*) y1, y2, hy
  21.      
  22.       if (((x2-x1).GT.0.AND.hx.LT.0).OR.((x2-x1).LT.0.AND.hx.GT.0)) then
  23.       msg = 'invalid input data for x'
  24.       call exeption(msg)
  25.       end if
  26.       if (((y2-y1).GT.0.AND.hy.LT.0).OR.((y2-y1).LT.0.AND.hy.GT.0)) then
  27.       msg = 'invalid input data for y'
  28.       call exeption(msg)
  29.       end if      
  30.       end
  31.      
  32.       subroutine output
  33.       logical bm, bn
  34.       common /values/ x1, x2, y1, y2, hx, hy
  35.      
  36.  100  format (E10.4, '   ' \)
  37.  101  format (A11, '    ' \)
  38.  102  format (E11.4, '    ' \)
  39.  103  format (A10, '   ' \)
  40.  104  format (A10)
  41.  
  42.       open(2, file = 'output.txt')
  43.  
  44.       a = abs((x2-x1)/hx)
  45.       b = abs((y2-y1)/hy)
  46.      
  47.       m = a + 1
  48.       n = b + 1
  49.      
  50.       bm = (a - int(a)).NE.0
  51.       bn = (b - int(b)).NE.0
  52.      
  53.       if (bm) m = m + 1
  54.       if (bn) n = n + 1
  55.      
  56.       write(2, 101) 'y\x'
  57.      
  58.       do x = x1,x2,hx
  59.         write(2, 100) x
  60.       end do
  61.      
  62.       if (bm) write(2, 100) x2
  63.      
  64.       write(2, 104)
  65.       write(2, 104)
  66.      
  67.       do y = y1,y2,hy
  68.         write(2, 102) y
  69.         do x = x1,x2,hx
  70.             if ((x+y).NE.0) then
  71.                 write(2, 100) f(x, y)
  72.             else
  73.                 write(2, 103) '+inf'
  74.             end if
  75.         end do
  76.         if (bm) write(2, 100) f(x2, y)
  77.         write (2, 104)
  78.       end do
  79.      
  80.       if (bn) then
  81.         write(2, 102) y
  82.         do x = x1,x2,hx
  83.             if ((x+y).NE.0) then
  84.                 write(2, 100) f(x, y2)
  85.             else
  86.                 write(2, 103) '+inf'
  87.             end if
  88.         end do
  89.         if (bm) write(2, 100) f(x2, y2)
  90.         write (2, 104)
  91.       end if
  92.      
  93.       close(2)
  94.       end
  95.      
  96.       subroutine exeption(message)
  97.       character*20 message
  98.       print *, message
  99.       pause
  100.       stop
  101.       end
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement