home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / hamradio / minimuf.for < prev    next >
Encoding:
Text File  |  1984-08-28  |  5.9 KB  |  250 lines
  1.  
  2. C     THIS VERSION WRITTEN FOR FORTRAN 77 USED ON PDP-11
  3. C     BY GERRY KERSUS, W1GD
  4. C
  5. C     Also works FB on a VAX-11/780  (N2IC)
  6.  
  7.       REAL A(2), C0(2), G6(2), G7(2), G8(2), Z(2)
  8.       REAL T1(2), T3(2), T4(2), T9(2)
  9.  
  10.       CHARACTER*3 PA
  11.       PI=3.14159
  12.  
  13.  
  14. C     NORTH LATITUDE AND WEST LONGITUDE IS POSITIVE
  15. C     OLAT IS HARD-CODED FOR THE ORIGINATING STATION LATITUDE
  16.       OLAT=40.0
  17. C     OLON IS HARD-CODED FOR THE ORIGINATING STATION LONGITUDE
  18.       OLON=-105.0
  19. C     DLAT & DLON ARE DESTINATION LATITUDE & LONGITUDE
  20.       PRINT *, 'ENTER DESTINATION LATITUDE AND LONGITUDE'
  21.       READ *, DLAT, DLON
  22.       DLON =-DLON
  23.  
  24. C     INPUT MONTH AS A NUMBER FROM 1 TO 12
  25.       PRINT *, 'ENTER MONTH (1-12)'
  26.       READ *, M0
  27.  
  28. C     INPUT DAY AS A NUMBER FROM 1 TO 31
  29.       PRINT *, 'ENTER DAY (1-31)'
  30.       READ *, D0
  31.  
  32. C     S0 IS THE SUNSPOT NUMBER
  33. C     SF IS THE SOLAR FLUX
  34.       PRINT *, 'ENTER SOLAR FLUX'
  35.       READ *, SF
  36.       S0=625.*(SQRT((0.73)**2-0.0032*(65.-SF))-.73)
  37.       IS0=NINT (S0)
  38.  
  39. C     PA INDICATES LONG PATH ("L") OR SHORT PATH ('S')
  40.       PA='S'
  41.  
  42.       W1=-(OLON-180.*(1+SGN(OLON-.001)))*PI/180.
  43.       W2=-(DLON-180.*(1+SGN(DLON-.001)))*PI/180.
  44.       A1=OLAT*PI/180.
  45.       A2=DLAT*PI/180.
  46.  
  47. C     ROTATE LONGITUDES
  48.       W3=W2-W1+.001
  49.       W3=PI*(1-SGN(W3))+W3
  50.       H1=SIN(A1)*SIN(A2)+COS(A1)*COS(A2)*COS(W3)
  51.       G1=ATAN(SQRT(1-H1*H1)/H1)+PI/2.*(1-SGN(H1))
  52.       IF (PA .EQ. 'L') THEN
  53.       G1=PI+PI-G1
  54.       ELSE
  55.       CONTINUE
  56.       END IF
  57. C     PATH LENGTH IN 4 KM UNITS
  58.       H0=INT(1.59*G1)+1.
  59. C     CALCULATE BEARING
  60.       H9=(SIN(A2)-H1*SIN(A1))/SIN(G1)/COS(A1)
  61.       H9=ATAN(SQRT(1-H9*H9)/H9)+PI/2.*(1-SGN(H9))
  62.       H9=H9*SGN(W3-PI)*SGN(PI-G1)
  63.       H9=H9+PI*(1-SGN(H9))
  64.       IB1=INT(H9*180./PI+.5)
  65.       PRINT 1, ' MONTH:', M0, ' SUNSPOT NO.', IS0
  66. 1     FORMAT (A, I2, A, I3)
  67.       PRINT 5, ' LONG/SHORT = ', PA, ' BEARING:', IB1
  68. 5     FORMAT (A, A, A, I3)
  69.       PRINT *, ' GMT        HPF        MUF        LUF'
  70.       
  71.       Y6=ATAN(1./TAN(G1/(H0+1.))-.952/SIN(G1/(H0+1.)))
  72.       IF (Y6 .LT. .314) THEN
  73.       Y6=.314
  74.       ELSE
  75.       END IF
  76.  
  77.       Y6=1./SQRT(1.-.965*COS(Y6)**2)
  78.       Y1=.0172*(10.+(M0-1.)*30.4+D0)
  79.       Y2=.409*COS(Y1)
  80.       Y1=.13*SIN(Y1)+.156*SIN(Y1+Y1)
  81. C     DIRECTION COSINE
  82.       H9=(SIN(A1)-COS(G1)*SIN(A2))/SIN(G1)/COS(A2)
  83.       Z9=SIN(2.5*G1/H0)
  84.       Z9=1.+2.5*Z9*SQRT(Z9)
  85.       Z0=1.-.5/H0
  86.  
  87.       DO 20 N = 1, 2
  88.       A9=COS(G1*Z0)*SIN(A2)+SIN(G1*Z0)*COS(A2)*H9
  89.       A0=PI/2.-(ATAN(SQRT(1.-A9*A9)/A9)+PI/2.*(1-SGN(A9)))
  90.       W0=(COS(G1*Z0)-SIN(A2)*A9)/COS(A2)/COS(A0)
  91.       W0=ATAN(SQRT(1.-W0*W0)/W0)+PI/2.*(1.-SGN(W0))
  92.       W0=PI-SGN(PI-G1*Z0)*(PI-W0)
  93.       W0=W3+W0*SGN(W3-PI)*SGN(PI-G1)+W1-.001
  94.       W0=W0-PI*(1.-SGN(PI+PI-W0))
  95.       T0=3.82*W0+12.+Y1
  96.       T0=T0-12.*(1.+SGN(T0-24.))*SGN(ABS(T0-24.))
  97.  
  98.       IF (COS(A0+Y2) .LE. -.26)THEN
  99.       T1(N)=0.
  100.       GO TO 15
  101.       ELSE
  102.       END IF
  103.       T1(N)=(SIN(Y2)*A9-.26)/(COS(Y2)*COS(A0)+.001)
  104.       T1(N)=12.-ATAN(T1(N)/SQRT(ABS(1.-T1(N)*T1(N))))*24./PI
  105.       T7=T0-T1(N)/2.
  106.       T3(N)=T7+12.*(1.-SGN(T7))*SGN(ABS(T7))
  107.       T7=T0+T1(N)/2.
  108.       T4(N)=T7-12.*(1.+SGN(T7-24.))*SGN(ABS(T7-24.))
  109.       C0(N)=ABS(COS(A0+Y2))
  110.       T9(N)=9.7*(C0(N)**8)
  111.       IF (T9(N) .LT. .1) THEN
  112.       T9(N)=.1
  113.       ELSE
  114.       END IF
  115.  
  116. 15    Z0=1.-Z0
  117.       U2=INT(12./T1(N))
  118.       U3=INT(T1(N)/12.)
  119.       Z(N)=Z9*.75*((12./T1(N)-1.)*SGN(U2)+1.)
  120.       Z(N)=Z(N)*(1+S0/100.*(1-(T1(N)/12.-1.)*SGN(U3)))
  121.       A9=ABS(A0+.21*SIN(W0+.35))   
  122.       G2=.5
  123.       IF (A9 .GE. (PI/4.)) THEN
  124.       Z(N)=Z(N)*(1.-.1*(1.+COS(A9*4.)))
  125.       G2=.2
  126.       ELSE
  127.       END IF
  128.  
  129.       A(N)=SIN(A9*4.)*G2
  130.       G8(N)=PI*T9(N)/T1(N)
  131.       T7=T1(N)/T9(N)
  132.       IF (T7 .GT. 85.) THEN
  133.       T7=85.
  134.       ELSE
  135.       END IF
  136.  
  137.       G7(N)=C0(N)*G8(N)*(EXP(-T7)+1.)
  138.       G6(N)=G7(N)*EXP((T1(N)-24.)/2.)
  139. 20    CONTINUE
  140.       DO 90 J = 1, 24
  141.       T5=J-1.
  142.       R9=100.
  143.       E9=0.
  144.       DO 80 N = 1, 2
  145.       G0=0.
  146.       G3=PI/2.
  147.       IF (T1(N) .EQ. 0.) THEN
  148.       GO TO 40
  149.       ELSE
  150.       CONTINUE
  151.       END IF
  152.       IF (T4(N) .LT. T3(N)) THEN
  153.       GO TO 25
  154.       ELSE
  155.       CONTINUE
  156.       END IF
  157. C     DAYTIME ?
  158.       IF (((T5-T3(N))*(T4(N)-T5)) .GT. 0.) THEN
  159.       GO TO 30
  160.       ELSE
  161.       GO TO 45
  162.       END IF
  163. C     NIGHT TIME ?
  164. 25    IF (((T5-T4(N))*(T3(N)-T5)) .GT. 0.) THEN
  165.       GO TO 45
  166.       ELSE
  167.       END IF
  168. C     EFFECTIVE COS X (DAY)
  169. 30    T6=T5+12.*(1.+SGN(T3(N)-T5))*SGN(ABS(T3(N)-T5))
  170.       G4=PI*(T6-T3(N))/T1(N)
  171.       T8=(T3(N)-T6)/T9(N)
  172.  
  173.       IF (ABS(T8) .GT. 85.) THEN
  174.       T8=85.*SGN(T8)
  175.       ELSE
  176.       END IF
  177.       G0=C0(N)*(SIN(G4)+G8(N)*(EXP(T8)-COS(G4)))
  178.       G3=PI/2.
  179.        
  180.       IF ((T6-T3(N)) .GT. (T1(N)/2.+3.)) THEN
  181.       GO TO 35
  182.       ELSE
  183.       G3=(T6-T3(N))/(T1(N)/2.+3.)*G3
  184.       ENDIF
  185. 35    G3=G3*(1.+SGN(A(N)))
  186.       IF (G0 .LT. G6(N)) THEN
  187.       G0=G6(N)
  188.       ELSE
  189.       END IF
  190. C     F0F2
  191. 40    G2=SQRT(7.+45*SQRT(G0/(1.+G8(N)*G8(N))))
  192.  
  193. C     HPF
  194.       G2=G2*Z(N)*1.27*(1.+SIN(G3)*A(N))
  195.       GO TO 50
  196. C     EFFECTIVE COS X (NIGHT)
  197. 45    T6=T5+12.*(1.+SGN(T4(N)-T5))*SGN(ABS(T4(N)-T5))
  198.       G4=PI*(T6-T4(N))/(24.-T1(N))
  199.       G0=G7(N)*EXP((T4(N)-T6)/2.)
  200.       G3=G4+(PI-G4)/4.*(1.+SGN(A(N)))
  201.       G4=0.
  202.       GO TO 40
  203. 50    IF (G2 .LT. R9) THEN
  204.       R9=G2
  205.       ELSE
  206.       END IF
  207. C     E LAYER
  208.       Y8=.2
  209.       IF (T1(N) .EQ. 0.) THEN
  210.       GO TO 55
  211.       ELSE IF ((T1(N)*G4) .EQ. 0.) THEN
  212.       GO TO 55
  213.       ELSE
  214.       END IF
  215.       Y9=C0(N)*SIN(PI*(T6-T3(N))/T1(N))
  216.       IF (Y9 .LE. .174) THEN
  217.       Y8=(ATAN(SQRT(1.-Y9*Y9)/Y9)*180./PI-76.)**(-.4)
  218.       ELSE
  219.       Y8=Y9**(.3)
  220.       END IF
  221. 55    Y9=(3.4+.00544*S0)*Y8*Y6
  222.       IF (Y9 .LE. 7.) THEN
  223.       Y9=.91*Y9-.37
  224.       ELSE
  225.       Y9=(1.33*Y9-3.31)**(2.)/7
  226.       END IF
  227.  
  228.       IF (E9 .LT. Y9) THEN
  229.       E9=Y9
  230.       ELSE
  231.       END IF
  232. 80    CONTINUE
  233.  
  234.       IT5=INT(T5)
  235.       HPF=(R9+.5)
  236.       RMUF=(R9/1.27+.5)
  237.       RLUF=(E9+.5)
  238.       PRINT 85, IT5, HPF, RMUF, RLUF
  239. 85    FORMAT (I6, 3F6.1)
  240.       
  241. 90    CONTINUE
  242.  
  243.       END
  244.  
  245.       FUNCTION SGN (X)
  246. C     THIS ROUTINE PROVIDES SIGNUM FUNCTION FOR ARGUMENT X
  247.       SGN=SIGN (0.5, X)-SIGN (0.5, -X)
  248.       RETURN
  249.       END
  250.