Advertisement
zodiak1

Untitled

Mar 12th, 2023
2,499
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.       COMMON /VAR/ x_min,x_max,x_step,y_min,y_max,y_step
  2.       COMMON /TABLE/ n,m
  3.       COMMON /PI/ pi
  4.       COMMON /eps/ eps,epsx,epsy
  5.       pi=3.1415926
  6.       eps=0.0001
  7.       CALL INPUT
  8.       CALL COLUMNS
  9.       CALL OUTPUT
  10.       END
  11.  
  12.       SUBROUTINE INPUT
  13.       COMMON /VAR/ x_min,x_max,x_step,y_min,y_max,y_step
  14.       COMMON /eps/ eps,epsx,epsy
  15.       OPEN (1,FILE='input.txt')
  16.       READ (1,*) x_min,x_max,x_step,y_min,y_max,y_step
  17.       CLOSE(1)
  18.       CALL EPS_X_Y
  19.       IF (x_min.GT.x_max.OR.y_min.GT.y_max)THEN
  20.       PRINT *,'The minimum is greater than the maximum'
  21.       PAUSE
  22.       STOP
  23.       END IF
  24.  
  25.       IF (x_step.LT.0.OR.y_step.LT.0)THEN
  26.       PRINT *,'Negative step'
  27.       PAUSE
  28.       STOP
  29.       END IF
  30.  
  31.       IF (ABS(x_step).LE.epsx.AND.(x_max-x_min).GT.epsx) THEN
  32.       PRINT *,'Incorrect data'
  33.       PAUSE
  34.       STOP
  35.       END IF
  36.  
  37.       IF (ABS(y_step).LE.epsy.AND.(y_max-y_min).GT.epsy) THEN
  38.       PRINT *,'Incorrect data'
  39.       PAUSE
  40.       STOP
  41.       END IF
  42.  
  43.       IF(x_step.GT.epsx) THEN
  44.       IF (ABS(DEGREE(x_max)-DEGREE(x_step)).GE.4.OR.
  45.       >     ABS(DEGREE(x_min)-DEGREE(x_step)).GE.4)THEN
  46.       PRINT *,'Invisible step by x'
  47.       PAUSE
  48.       STOP
  49.       END IF
  50.       END IF
  51.  
  52.       IF(y_step.GT.epsy) THEN
  53.       IF (ABS(DEGREE(y_max)-DEGREE(y_step)).GE.4.OR.
  54.       >     ABS(DEGREE(y_min)-DEGREE(y_step)).GE.4)THEN
  55.       PRINT *,'Invisible step by y'
  56.       PAUSE
  57.       STOP
  58.       END IF
  59.       END IF
  60.       END
  61.  
  62.       SUBROUTINE COLUMNS
  63.       COMMON /TABLE/ n,m
  64.       COMMON /VAR/ x_min,x_max,x_step,y_min,y_max,y_step
  65.       COMMON /eps/ eps,epsx,epsy
  66.  
  67.       IF (ABS(x_step).LE.epsx.OR.(x_max-x_min).LE.epsx)THEN
  68.       n=1
  69.       ELSE
  70.       IF (ABS(MOD((x_max-x_min),x_step)).LE.eps)THEN
  71.       n=(x_max-x_min+x_step/2)/x_step+1
  72.       ELSE
  73.       n=(x_max-x_min)/x_step+2
  74.       END IF
  75.       END IF
  76.  
  77.       IF (ABS(y_step).LE.epsy.OR.(y_max-y_min).LE.epsy)THEN
  78.       m=1
  79.       ELSE
  80.       IF (ABS(MOD((y_max-y_min),y_step)).LE.eps)THEN
  81.       m=(y_max-y_min+y_step/2)/y_step+1
  82.       ELSE
  83.       m=(y_max-y_min)/y_step+2
  84.       END IF
  85.       END IF
  86.       END
  87.  
  88.       SUBROUTINE OUTPUT
  89.       COMMON /VAR/ x_min,x_max,x_step,y_min,y_max,y_step
  90.       COMMON /TABLE/ n,m
  91.       COMMON /PI/ pi
  92.       COMMON /eps/ eps,epsx,epsy
  93.       x_current=x_min
  94.       y_current=y_min
  95.  
  96.       OPEN(2, file='output.txt')
  97.       WRITE(2,20)'x\y    '  
  98.       DO i=0,m-2
  99.       IF ((ABS(y_current+y_step)).GE.(ABS(1E-04*(y_current)))) THEN
  100.       y_current=y_min+y_step*i
  101.       WRITE (2,10) y_current
  102.       ELSE
  103.       y_current=0
  104.       WRITE (2,10) y_current
  105.       END IF
  106.       END DO
  107.  
  108.       WRITE(2,10) y_max
  109.       WRITE(2,50)
  110.       write(2,20) '-----------'
  111.       DO i=1,m
  112.       write(2,40) '-----------'
  113.       END DO
  114.       WRITE(2,50)
  115.  
  116.       DO i=0,n-1
  117.       IF((x_min + x_step * i).GT.x_max)THEN
  118.       x_current = x_max
  119.       ELSE
  120.           IF(ABS(x_min + x_step * i).LE.epsx)THEN
  121.           x_current = 0
  122.           ELSE
  123.           x_current = x_min + x_step * i
  124.       END IF
  125.       END IF
  126.       WRITE (2,30) x_current
  127.       y_current=y_min
  128.       DO j=1,m
  129.         IF(ABS(COS((x_current+y_current)*pi/180)).LE.eps) THEN
  130.         WRITE(2,40)'inf    '
  131.         ELSE
  132.           IF(ABS(SIN((x_current+y_current)*pi/180)).LE.eps) THEN
  133.           func=0E4
  134.           WRITE(2,10) func
  135.           ELSE
  136.           func=TAN((x_current+y_current)*pi/180)
  137.           WRITE (2,10) func
  138.           END IF
  139.         END IF
  140.         IF(ABS(y_min + y_step * j).LE.epsy)THEN
  141.         y_current = 0
  142.         ELSE
  143.         y_current=y_min+y_step*j
  144.         END IF
  145.         IF((y_min + y_step * j).GT.y_max)THEN
  146.         y_current = y_max
  147.         END IF
  148.         END DO
  149.       WRITE(2,60)
  150.       END DO
  151.  
  152.       10    FORMAT(E11.4,'|'\)
  153.       20    FORMAT(A11,'||'\)
  154.       30    FORMAT(E11.4,'||'\)
  155.       40    FORMAT(A11,'|'\)
  156.       50    FORMAT(A1)
  157.       60    FORMAT(A1,\)
  158.       END
  159.  
  160.       SUBROUTINE EPS_X_Y
  161.       COMMON /VAR/ x_min,x_max,x_step,y_min,y_max,y_step
  162.       COMMON /eps/ eps,epsx,epsy
  163.  
  164.       IF(x_step.NE.0)THEN
  165.       IF(ABS(x_min).LE.ABS(x_step).AND.x_min.NE.0) THEN
  166.       J1=DEGREE(x_min)
  167.       ELSE
  168.           IF(ABS(x_max).GE.ABS(x_step).AND.x_step.NE.0) THEN
  169.           J1=DEGREE(x_step)
  170.           ELSE
  171.           J1=DEGREE(x_max)
  172.           END IF
  173.       END IF
  174.       ELSE
  175.       IF(ABS(x_max).GE.ABS(x_min).AND.x_min.NE.0) THEN
  176.           J1=DEGREE(x_min)
  177.           ELSE
  178.           J1=DEGREE(x_max)
  179.       END IF
  180.       END IF
  181.  
  182.       IF (J1.GE.0)THEN
  183.       epsx=(10**J1)*1E-4
  184.       ELSE
  185.       epsx=1
  186.       DO i=2, ABS(J1)
  187.       epsx=epsx/10
  188.       END DO
  189.       epsx=epsx*1E-4
  190.       END IF
  191.  
  192.       IF(y_step.NE.0)THEN
  193.       IF(ABS(y_min).LE.ABS(y_step).AND.y_min.NE.0) THEN
  194.       J2=DEGREE(y_min)
  195.       ELSE
  196.           IF(ABS(y_max).GE.ABS(y_step).AND.y_step.NE.0) THEN
  197.           J2=DEGREE(y_step)
  198.           ELSE
  199.           J2=DEGREE(y_max)
  200.           END IF
  201.       END IF
  202.       ELSE
  203.       IF(ABS(y_max).GE.ABS(y_min).AND.y_min.NE.0) THEN
  204.           J2=DEGREE(y_min)
  205.           ELSE
  206.           J2=DEGREE(y_max)
  207.       END IF
  208.       END IF
  209.  
  210.       IF (J2.GE.0)THEN
  211.       epsy=(10**J2)*1E-4
  212.       ELSE
  213.       epsy=1
  214.       DO i=2, ABS(J2)
  215.       epsy=epsy/10
  216.       END DO
  217.       epsy=epsy*1E-4
  218.       END IF
  219.       END
  220.  
  221.       REAL FUNCTION DEGREE(a)
  222.       IF (a.EQ.0) THEN
  223.       DEGREE=0
  224.       ELSE
  225.       DEGREE=AINT(log10(ABS(a)))
  226.       END IF
  227.       RETURN
  228.       END
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement