C     Code comes from "Prediction of Tropospheric Radio Transmission
C     Loss Over Irregular Terrain, A Computer Method-1968", Longley and
C     Rice.
C
C     I started with the OCR code from the report and fixed the many
C     errors.  Typing from scratch might have been faster.  Corrections
C     were also made as given in errata.  The original, uncorrected
C     lines remain, commented out with "C!!!".  I plan to update this
C     to get it running with a present-day compiler...just for old
C     time's sake!
C
C     Mike Markowski, mike.ab3ap@gmail.com
C     Nov 2022

C     PROGRAM COMTE
C     PROGRAM TO DETERMINE PARAMETERS AND WRITE OUTPUT
C
      COMMON /M/F,D,NS,A,DH,DHS,S,E,POL,KM
      COMMON /MP/ H1E,H2E,H1G,H2G,DLS1,DLS2,DL1,DL2,DL,DLS,TE1,TE2,TE,KL
      COMMON /MLDS/ AG,AD,AS,ACR,AED,MD,AH50,AH5,D5,MS,AES,DX,H5
      COMMON /ML/ D0,D1,D01,D02,A0,A1,K1,K2,AL,ALS,A0G
C!!!  DIMENSION ANS(3),DKM(6),DELH(6),SD(6),SA(6)
      DIMENSION ANS(3),DKM(6),SD(6),SA(6)
      REAL NS,MD,MDO,MS,MSS,MDS,K1,K2,K3,K4,LBF
      DATA ANS/290.,290.,312./
      DATA DKM/5.,10.,20.,30.,50.,80./
C!!!  DATA (DELH=105.,165.,234.,315.,575.)
C
C     CALCULATION OF INPUT PARAMETERS
C
      S=.005
      E=15.
      DO 500 IX=1,3
      NS=ANS(IX)
      A=6370./(1.-.04665*EXP(.005577*NS))
56    FORMAT (1X)
      WRITE ( 4,56)
57    FORMAT (2X,'COLORADO PLAINS   NS=290.'//)
58    FORMAT (2X,'COL0RADO MOUNTAINS   NS=290.'//)
59    FORMAT (2X,'OHIO   NS=312.'//)
      IF (IX .EQ. 1) WRITE ( 4,57)
      IF (IX .EQ. 2) WRITE ( 4,58)
      IF (IX .EQ. 3) WRITE ( 4,59)
      DO 400 I=1,9
      KK=0
      DO 300 IZ=1,6
      IF (IX .EQ. 2 .AND. IZ .EQ. 6) GO TO 300
      IF (IX .EQ. 3 .AND. (IZ .EQ. 1 .OR. IZ .EQ. 6)) GO TO 300
      D=DKM(IZ)
      DH=90.
      DHS=90.
      IF (IX .NE. 2) GO TO 999
        DH=650.
        DHS=650.
999   CONTINUE
      F=100.
      IF (I .GT. 6) F=50.
      IF (I .EQ. 9) F=20.
      POL=+1.
      IF (I .GT. 3 .AND. I .LT. 7) POL=-1.
      H1G=4.
      H1E=4.
      IF (IX .EQ. 3 .OR. I .NE. 9) GO TO 998
        H1G=3.3
        H1E=3.3
998   CONTINUE
      IF (IX .NE. 3 .OR. I .LE. 6) GO TO 997
        H1G=4.24
        H1E=4.24
997   CONTINUE
      IF (IX .NE. 3 .OR. I .NE. 9) GO TO 996
        H1G=3.68
        H1E=3.68
996   CONTINUE
      H2G=3.
      H2E=3.
      IF (I .NE. 2 .AND. I .NE. 5) GO TO 995
        H2G=6.
        H2E=6.
995   CONTINUE
      IF (I .NE. 3 .AND. I .NE. 6) GO TO 994
        H2G=9.
        H2E=9.
994   CONTINUE
      IF (IX .NE. 3 .OR. I .NE. 7) GO TO 993
        H2G=1.
        H2E=1.
993   CONTINUE
      IF (IX .EQ. 3 .OR. I .NE. 7) GO TO 992
        H2G=.55
        H2E=.55
992   CONTINUE
      IF (IX .EQ. 3 .OR. I .NE. 8) GO TO 991
        H2G=1.7
        H2E=1.7
991   CONTINUE
      IF (IX .EQ. 3 .OR. I .NE. 9) GO TO 990
        H2G=1.3
        H2E=1.3
990   CONTINUE
      DLS1=SQRT(.002*A*H1E)
      DLS2=SQRT(.002*A*H2E)
      DLS=DLS1+DLS2
C!!!  DL1=DLS1*EXP(-.07*SQRT(DH/H1E))
C!!!  DL2=DLS2*EXP(-.07*SQRT(DH/H2E))
      DL1=DLS1*EXP(-.07*SQRT(DH/AMAX1(5.,H1E)))
      DL2=DLS2*EXP(-.07*SQRT(DH/AMAX1(5.,H2E)))
      DL=DL1+DL2
      TE1=(.00065/DLS1)*((DLS1/DL1-1.)*DH-3.077*H1E)
      TE2=(.00065/DLS2)*((DLS2/DL2-1.)*DH-3.077*H2E)
      TE=AMAX1((TE1+TE2),(-DL/A))
      KK=KK+1
      IF (D .GT. DLS) GO TO 40
      CALL LOS
      SD(KK)=D
      SA(KK)=ACR
      GO TO 300
40    CALL DIFF
      SD(KK)=D
      SA(KK)=ACR
      IF (IX .EQ. 1 .AND. KK .NE. 6) GO TO 300
      IF (IX .EQ. 2 .AND. KK .NE. 5) GO TO 300
      IF (IX .EQ. 3 .AND. KK .NE. 4) GO TO 300
      AE=A0G-K1*D0-K2*ALOG10(D0)
C
C     WRITE OUTPUT
C
60    FORMAT (4X,'F='F6.1,'   DH='F6.2,'   H1G='F6.2,'   H2G='F6.2,
     C'   TE='F10.6,'   DX='F8.2)
      WRITE ( 4,60) F,DH,H1G,H2G,TE,DX
61    FORMAT (4X,'AE='F8.2,'   K1='F10.5,'   K2='F10.5,'   DLS='F8.2,
     C'   ALS='F8.2)
      WRITE ( 4,61) AE,K1,K2,DLS,ALS
      ADX=AED+MD*DX
62    FORMAT (4X,'AED='F8.2,'   MD='F10.5,'   AES='F8.2,'   MS='F10.5,
     C'   ADX='F8.2)
      WRITE( 4,62) AED,MD,AES,MS,ADX
63    FORMAT (4X,'D'6F10.2)
64    FORMAT (4X,'A'6F10.2)
      WRITE (4,63) (SD(JZ), JZ=1,KK)
      WRITE ( 4,64) (SA(JZ), JZ=1,KK)
      WRITE ( 4,56)
300   CONTINUE
400   CONTINUE
500   CONTINUE
      CALL EXIT
      END

