      SUBROUTINE HYINP
C--CALLED BY HYPOINVERSE TO PROMPT FOR PHASE DATA & OUTPUT IT TO A FILE
C--IN CONDENSED FORMAT.
C--LASK IS A LOGICAL FUNCTION. THE g77 COMPILER COMPLAINS WITHOUT THESE LINES
      LOGICAL LASK
      EXTERNAL LASK
      LOGICAL LALL, LO
      CHARACTER STA*5,STA2*2,STA1*1,STA3*3
      CHARACTER STAS(100)*5,STAN(100)*2,STAC1(100)*1,STAC3(100)*3
      CHARACTER IFL*80,PRMK*4,SRMK*4,RMKP*4,RMKS*4
      CHARACTER SCHR(100)*1,ACHR(100)*1,CCHR(100)*1,NUMSTR*20
C--TELL HYPOINVERSE TO READ THE NEXT PHASE FILE IN CONDENSED FORMAT
C      JCP=2
C--INITIALIZE DATA
      PRMK=' P 0'
      SRMK=' S 2'
      RMKP=' P 0'
      RMKS=' S 2'
      IY=0
      IM=0
      ID=0
      IH=0
      IN=0

      WRITE (6,*)' INTERACTIVE PHASE DATA ENTRY.  READS A FILE OF'
      WRITE (6,*)' STATION NAMES FOR PROMPTING (DEFAULT IS stalist.dat)'
      WRITE (6,*)' PRESS RETURN FOR DEFAULT DATA OR FOR NO DATA.'
C--PROMPT FOR & OPEN OUTPUT FILE
      CALL ASKC ('PHASE DATA OUTPUT FILENAME',IFL)
      CALL OPENW (14,IFL,'F',IOS,'A')

C--LOOK FOR LIST OF STATIONS TO PROMPT FOR ON FILE 'stalist.'
C--IF STALIST IS NOT THERE, REQUEST ANOTHER FILENAME.
      CALL OPENR (12,'stalist.dat','F',IOS)
      IF (IOS.NE.0) THEN
10      CALL ASKC
     2 ('FILE NOT FOUND. FILE OF STATION NAMES TO PROMPT FOR',IFL)
        CALL OPENR (12,IFL,'F',IOS)
        IF (IOS.NE.0) GOTO 10
      END IF

C--READ IN LIST OF STATIONS TO PROMPT FOR
15    DO I=1,100
16      READ (12,1003,END=20) STAS(I),STAN(I),STAC1(I),STAC3(I),
     2 SCHR(I),ACHR(I),CCHR(I)
1003    FORMAT (A5,1X,A2,1X,A1,A3,1X,3A1)
        IF (STAS(I).EQ.'     ') GOTO 16
      END DO
20    NSTA=I-1
      CLOSE (12)

C--SET THE FLAG THAT PROMPTS FOR A P REMARK, FIRST MOTION & WEIGHT
      WRITE (6,1007)
1007  FORMAT (' DO YOU WANT TO ENTER REMARKS, FIRST MOTIONS & WEIGHTS')
      LALL= LASK ('FOR ALL STATIONS',LALL)

      IF (LALL) WRITE (6,1012)
1012  FORMAT (' REMARKS ARE 4 CHARACTERS LONG, AND CONSIST OF'/
     2 ' QUALITY, P OR S, FIRST MOTION, & WEIGHT,'/
     3 ' FOR EXAMPLE "IPU0" OR "ES 2". RETURN USES SIMPLY "P" OR "S".')

C******************* EVENT LOOP ******************************

C--PROMPT FOR DATE & TIME
25    WRITE (6,1004)
1004  FORMAT (1X,5('----'),/' FOR THE NEXT EVENT:')
      IY=JASK(' YEAR (2 DIGITS)',IY)
      IM=JASK('MONTH',IM)
      ID=JASK('  DAY',ID)
      IH=JASK(' HOUR',IH)
      IN=JASK('  MIN',IN)

C      WRITE (6,1006)
C1006  FORMAT (' ENTER P TIMES:')

C--LOOP OVER STATIONS IN THE PROMPTING LIST
C--ASSUME A P TIME IS TO BE ENTERED FOR MOST STATIONS
      DO 50 I=1,NSTA

C--INPUT P TIME IN FREE FORMAT, CR SKIPS THE STATION
30    WRITE (6,1010) STAS(I),STAN(I),STAC1(I),STAC3(I)
1010  FORMAT (' P-TIME FOR ',A5,A2,1X,A1,A3,': ',$)

C--READ P TIME
      READ (5,'(A)') NUMSTR
      IF (NUMSTR(1:4).NE.'    ') THEN
        READ (NUMSTR,*,ERR=30) P
        PRMK=' P 0'
      ELSE
        P=0.
        PRMK=' P 4'
      END IF

C--THE TIME IN 1/100 SECONDS AS AN INTEGER
      IP=NINT(P*100.)

C--OPTIONALLY INPUT S REMARK & WEIGHT
      IF (LALL .AND. IP.NE.0) THEN
        PRMK=' P 0'
        CALL ASKC ('P REMK & WEIGHT (A4)',PRMK)
        IF (PRMK.EQ.'    ') PRMK=' P 0'
      END IF

C--INPUT A DURATION IF THIS STATION WAS FLAGGED
      IC=0
      IF (CCHR(I).NE.' ') THEN
46      WRITE (6,1027) STAS(I)
1027    FORMAT (' CODA DURATION FOR ',A5,': ',$)
        READ (5,'(A)') NUMSTR
        IF (NUMSTR(1:4).NE.'    ') THEN
          READ (NUMSTR,*,ERR=46) C
        ELSE
          C=0.
        END IF
        IC=NINT(C)
      END IF

C--NOW INPUT AN S TIME IF THIS STATION WAS FLAGGED
      SRMK='    '
      IS=0
      IF (SCHR(I).NE.' ') THEN

C--INPUT S TIME IN FREE FORMAT, CR SKIPS THE STATION
40      WRITE (6,1024) STAS(I)
1024    FORMAT (' S TIME FOR ',A5,': ',$)
        READ (5,'(A)') NUMSTR
        IF (NUMSTR(1:4).NE.'    ') THEN
          READ (NUMSTR,*,ERR=40) S
          SRMK=' S  '
        ELSE
          S=0.
          SRMK='    '
        END IF

C--S TIME IN 1/100 SECONDS AS AN INTEGER
        IS=NINT(S*100.)

C--OPTIONALLY INPUT S REMARK & WEIGHT
        IF (LALL .AND. IS.NE.0) THEN
          SRMK=' S 2'
          CALL ASKC ('S REMK & WEIGHT (A4)',SRMK)
          IF (SRMK.EQ.'    ') SRMK=' S  '
        END IF
      END IF

C--INPUT AN AMPLITUDE IF THIS STATION WAS FLAGGED
      IA=0
      IF (ACHR(I).NE.' ') THEN
44      WRITE (6,1025) STAS(I)
1025    FORMAT (' AMPLITUDE FOR ',A5,': ',$)
        READ (5,'(A)') NUMSTR
        IF (NUMSTR(1:4).NE.'    ') THEN
          READ (NUMSTR,*,ERR=44) A
        ELSE
          A=0.
        END IF
        IA=NINT(A)
      END IF

C--WRITE STATION LINE
      IF (IP.GT.0 .OR. IC.GT.0 .OR. IS.GT.0 .OR. IA.GT.0)
     2 WRITE (14,1100) STAS(I)(1:4),PRMK,STAC1(I), IY,IM,ID,IH,IN,IP,
     3 IS,SRMK,IA, IC, STAS(I)(5:5),STAC3(I),STAN(I)
1100  FORMAT (A4,A4,A1, 5I2.2,I5,
     3 T32,I5,A4,4X,I3, T72,I4,2X, A1,A3,A2)

C--END OF STATION LOOP
50    CONTINUE

C------------------------------------------------------------
C--OPTIONALLY ENTER A TIME FOR A STATION NOT ON PROMPT LIST
60    LO=LASK('ENTER ANOTHER P, S OR CODA FOR THIS EVENT',.FALSE.)
      IF (.NOT.LO) GOTO 80

C--GET STATION NAME & REMARK
      CALL ASKC ('STATION SITE  CODE (A5)',STA)
      CALL ASKC ('STATION NET   CODE (A2)',STA2)
      CALL ASKC ('STATION COMP1 CODE (A1)',STA1)
      CALL ASKC ('STATION COMP3 CODE (A3)',STA3)

C--GET STATION P TIME
C  HIT RETURN (NO ENTRY) OR 0 FOR NO NUMERIC DATA
65    P=ASKR('P TIME (0 FOR NONE)',0.)
      IF (P.NE.0.) THEN
        RMKP=' P 0'
        IF (LALL) CALL ASKC ('P REMARK & WEIGHT (A4)',RMKP)
      ELSE
        RMKP=' P 4'
      END IF
      IP=NINT(P*100.)

C--GET STATION S TIME
C  HIT RETURN (NO ENTRY) OR 0 FOR NO NUMERIC DATA
66    S=ASKR('S TIME (0 FOR NONE)',0.)
      IF (S.NE.0.) THEN
        RMKS=' S 0'
        IF (LALL) CALL ASKC ('S REMARK & WEIGHT (A4)',RMKS)
      ELSE
C        RMKS='    '
        RMKS=' S 4'
      END IF
      IS=NINT(S*100.)

C--GET CODA
      C=ASKR('CODA DURATION (0 FOR NONE)',0.)
      IC=NINT(C)

C--GET STATION AMPLITUDE
      A=ASKR('AMPLITUDE (0 FOR NONE)',0.)
      IA=NINT(A)

C--WRITE STATION LINE
      WRITE (14,1100) STA(1:4),RMKP,STA1, IY,IM,ID,IH,IN,IP,
     3 IS,RMKS,IA, IC, STA(5:5),STA3,STA2
      GOTO 60

C--WRITE TERMINATOR LINE
80    WRITE (14,'(1X)')

C--DECIDE WHETHER TO ENTER ANOTHER EVENT
      LO=LASK('STOP ENTERING DATA & RETURN TO COMMAND LEVEL',.FALSE.)
      IF (.NOT.LO) GOTO 25

      CLOSE (14)
      RETURN
      END
