C ***  PROGRAM: XRDPLT - PLOT THE VARIOUS X-RAY DATA FILES
C ***  VERSION: 900401
C ***  AUTHOR : S.A.HOWARD
C *             DEPARTMENT OF CERAMIC ENGINEERING
C *             UNIVERSITY OF MISSOURI - ROLLA
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      LOGICAL LVIDEO,LREDRW,LDHARD,EXISTS,LMORE
      LOGICAL EOFHIT,FILEOK,LAXGET,LHPFIL
      CHARACTER QNAME*64,QEXT*3,QFMT*38,QNFMT*2,QPTDEF(0:1)*12
      CHARACTER QDATE*9,QTIME*8,QANS*1
      EQUIVALENCE ( QFMT(31:32), QNFMT )
      DATA QEXT /'hp?'/
      DATA QFMT /'(''$Plotting command file? <'',Axx,''> '')'/
      DATA QPTDEF(0)/'Unformatted.'/
      DATA QPTDEF(1)/'Formatted.  '/
C *
C *  ENSURE ACCESS
CZZZ  CALL ACCESS
C *
C **  SAY HELLO
C *
1000  CALL DATE(QDATE)
      CALL TIME(QTIME)
      IF(KMODEO.EQ.0) THEN
        WRITE(ITTO,1002) ' ',KVERSN,QDATE,QTIME(1:5)
1002    FORMAT(A1,
     1'*** XRDPLT - Plotting',14X,'V ',I6,13X,'Run',2X,A9,2X,A5)
      WRITE(ITTO,1004) QPTDEF(KFLPDT)
1004  FORMAT(/,
     1' Lisenced to NIST under agreement 40NANBO1553',/,
     1' (C) Materials Data, Inc. / S.A. Howard.',///,
     1' Options for questions are given in () and their',
     1' defaults in <>.',/,
     1' A / should be routinely used to get the defaults.',//,
     1' The default plot file type is ',A12,' Follow the file name',
     1' with /F or /U',/,
     1' to explicitly set the file type to Formatted or Unformatted,',
     1' respectively.')
       ELSE
        WRITE(ITTO,1002) '1',KVERSN,QDATE,QTIME(1:5)
      ENDIF
C *
C **  GET THE DEFAULTS FROM THE DEFAULT FILE
C *
C *  GET THE DEFAULTS FROM XRDPLT.DFT
      CALL GETXDF
C *
C *  INITIALIZE PROGRAM MODE TO INTERACTIVE (NOT FULLY IMPLEMENTED)
      KMODEO = 0
C *
C *  LDHARD- DEFAULT HARDCOPY MODE, LVIDEO- CURRENT MODE
      LDHARD = KDEVIC.EQ.1
      LVIDEO = KDEVIC.EQ.0
C *
C *  MARK HP_PLOTTER FILE CLOSED
      LHPFIL = .FALSE.
C *
C **  SET DEFAULT PLOTTING CONSTANTS
C *
C *  X-AXIS PARAMETERS
1010  KXAXID =       1
      XAXBEG =     0.0
      XAXEND =     1.0
      XAXDEL =     1.0
      KAXXRV =       0
C *
C *  Y-AXIS PARAMETERS
      KYAXID =          1
      YAXBEG = PXDFTI(12)
      YAXEND = PXDFTI(13)
      YAXDEL =        1.0
C *
C *  GRAPH-RELATED PARAMETERS
      KAXBOX =       1
      KAXSIZ =       0
      KAXDRW =       1
C *
C *  FILE-TRACKING PARAMETERS
      KFLTOT =       0
      KFLCUR =       0
C *
C *  INTERACTIVELY PLACED MARKER PARAMETERS
      KVSNUM  =      0
      KVLNUM  =      0
C *
C *  AUTO-SCALING PARAMETERS
      IF(PXDFTI(12).EQ.-99.0) THEN
        KASCYL =       1
       ELSE
        KASCYL =       0
      ENDIF
      IF(PXDFTI(13).EQ.-99.0) THEN
        KASCYH =       1
       ELSE
        KASCYH =       0
      ENDIF
C *
C *  NEXT DATA GROUP SYMBOL NUMBER
      KDGSYN = 1
C *
C *  MISC. PARAMETERS
      LAXGET =  .TRUE.
      LREDRW = .FALSE.
      LMORE  = .FALSE.
      IDNUMB = 0
C *
C *  CLOSE THE PLOTTING FILE IF OPEN
C *
      IF(LHPFIL) THEN
        CLOSE(UNIT=1)
        LHPFIL = .FALSE.
      ENDIF
C *
C **  GET THE NEXT FILE TYPE AND NAME
C *
1020  KFLCUR = KFLTOT + 1
      IF(KMODEO.EQ.0) WRITE(ITTO,1050)
1050  FORMAT(/,'$Type of file to plot? (A) Pattern (B) Plot <B> ')
      READ(ITTI,1060) QANS
1060  FORMAT(A1)
      KFLTYP(KFLCUR) = 1
      IF( QANS.EQ.'A' .OR. QANS.EQ.'a' ) KFLTYP(KFLCUR) = 0
      IF( KMODEO.EQ.1 .AND. KFLTYP(KFLCUR).EQ.0 ) WRITE(ITTO,1062)
1062  FORMAT(/,' Input file format is * PATTERN *')
      IF( KMODEO.EQ.1 .AND. KFLTYP(KFLCUR).EQ.1 ) WRITE(ITTO,1064)
1064  FORMAT(/,' Input file format is * PLOT *')
C *
C *  GET THE FILE NAME, OPEN IT AND GET THE DATA-GROUP PLOTTING PARAMETERS
2000  IF(KFLTYP(KFLCUR).EQ.0) THEN
        CALL INIPAT( FILEOK, LAXGET, .TRUE. )
      ELSE
        CALL INIPLT( FILEOK, LAXGET, .TRUE. )
      ENDIF
      IF(.NOT.FILEOK) THEN
        KFLCUR = KFLCUR - 1
        GO TO 6000
      ENDIF
      KFLTOT = KFLTOT + 1
      CLOSE(UNIT=IDFI)
C *
C *  IF ANOTHER DATA SET IS BEING ADDED AND VIDEO MODE THEN BACK TO MENU
C *
      IF(LMORE) THEN
        LMORE = .FALSE.
        IF(LVIDEO) GO TO 6000
      ENDIF
C *
C **  GET AXIS PARAMETERS, INITIALIZE PLOTTING ROUTINES, PLOT AXIS
C *
C *  GET AXIS PARAMETERS IF NEEDED, OR SET TO CURRENT PLOTTING DEVICE
3000  CALL GETAXS( LAXGET )
C *
C *  OPEN THE HP OUTPUT FILE IF NECESSARY
      IF( .NOT.LVIDEO .AND. KOUTPT.NE.0 .AND. .NOT.LHPFIL ) THEN
        QNAME = QFLNAM(1)
        QEXT(3:3) = CHAR( ICHAR('A') + MIN(IDNUMB,25) )
        IDNUMB = IDNUMB + 1
        IDCHAR = NPARSF( QNAME, QHPSTO, QEXT )
        WRITE(QNFMT,3010) IDCHAR
3010    FORMAT(I2)
        WRITE(ITTO,QFMT) QHPSTO(1:IDCHAR)
        READ(ITTI,3020) QNAME
3020    FORMAT(A64)
        IF( QNAME.NE.' ' .AND. QNAME.NE.'/' ) THEN
         QHPSTO = QNAME
         IDNUMB = IDNUMB - 1
        ENDIF
        INQUIRE(FILE=QHPSTO,EXIST=EXISTS)
        IF(EXISTS) THEN
          OPEN(UNIT=1,FILE=QHPSTO,STATUS='OLD')
          CLOSE(UNIT=1,STATUS='DELETE')
          WRITE(ITTO,3030)
3030      FORMAT(' -Deleting existing file with same name.')
        ENDIF
        LHPFIL = .TRUE.
      ENDIF
C *
C * INITIALIZE THE PLOTTING ROUTINES ONLY IF NEEDED.
      IF( LAXGET .OR. LVIDEO .OR. LREDRW ) THEN
        CALL START( XAXORG, YAXORG )
        IF(PPLSCA.NE.1.0) CALL FACTOR( PPLSCA )
      ENDIF
C *
C *  PLOT THE AXIS SYSTEM AND RESET LABEL COUNTER
      IF( LAXGET .OR. LVIDEO .OR. LREDRW ) THEN
        CALL PLTAXS
        NLABEL = 0
      ENDIF
      LAXGET = .FALSE.
C *
C *  DRAW THE INTERNAL MARKERS NOW SO VIDEO LOOKS GOOD
      CALL COORDS( 1, IRET )
C *
C **  REPEAT FOR EVERY PATTERN
C *
3100  IF( LVIDEO .OR. LREDRW ) THEN
        NSTRT = 1
       ELSE
        NSTRT = KFLTOT
      ENDIF
C *
      DO 3110 KFLCUR=NSTRT,KFLTOT
C *
C *  OPEN THE APPROPRIATE FILE AND READ HEADER RECORDS
      IF(KFLTYP(KFLCUR).EQ.0) THEN
        CALL INIPAT( FILEOK, LAXGET, .FALSE. )
      ELSE
        CALL INIPLT( FILEOK, LAXGET, .FALSE. )
      ENDIF
C *
C *  USE PLTLAB TO LABEL THE DATA GROUPS
3200  DO 3210 I=1,KDGNUM(KFLCUR)
      CALL PLTLAB( I, NLABEL, ICODE )
      NLABEL = NLABEL + ICODE
3210  CONTINUE
C *
C *  READ THE NEXT DATA SET AND PROCEED BASED ON RETURN STATUS
5000  IF(KFLTYP(KFLCUR).EQ.0) THEN
        CALL GETPAT( NSET, EOFHIT )
       ELSE
        CALL GETPLT( NSET, EOFHIT )
      ENDIF
C *
C *  IF NO POINTS AND NOT END OF FILE... TRY NEXT SEGMENT
      IF( NDVPTS.EQ.0 .AND. .NOT.EOFHIT ) GO TO 5000
C *
C *  IF NO POINTS AND END OF FILE... FINISHED
      IF( NDVPTS.EQ.0 .AND.      EOFHIT ) GO TO 3120
C *
C *  DATA CODE: 0 = TWO-THETA,INTENSITY DATA, 1 X-Y DATA, 2 MARKERS
C *  3,4 ERROR BARS
      KDTYPE = KDGTYP(KFLCUR,NSET)
      IF( KDTYPE.EQ.0 .OR. KDTYPE.EQ.1 ) CALL PLTDAT( NSET )
      IF( KDTYPE.EQ.2                  ) CALL PLTSTK( NSET )
      IF( KDTYPE.EQ.3                  ) CALL PLVERR( NSET )
      IF( KDTYPE.EQ.4                  ) CALL PLHERR( NSET )
C *
C *  IF NOT END OF FILE... GET NEXT SEGMENT
      IF(.NOT.EOFHIT) GO TO 5000
C *
C *  CLOSE THE CURRENT FILE
3120  CLOSE(UNIT=IDFI)
C *
C *  REPEAT FOR NEXT FILE
3110  CONTINUE
C *
C **  GET DIGITIZED INPUT IF IN VIDEO MODE
C *
4000  IF(LVIDEO) THEN
        CALL TEKOUT
        QANS = CHAR(7)
C        WRITE(ITTO,6002) QANS
6002    FORMAT(' ',A1)
        CALL COORDS( 0, IRET )
C        WRITE(ITTO,6002) QANS
C        READ(5,'(A1)') QANS
        CALL ERASE
       ELSE
        IRET = 0
      ENDIF
C *
C **  TERMINATE PLOTTING ROUTINES OR COMPLETE PENDING GRAPHICS
C *
C *  DUMP GRAPHICS BUFFER IF CURRENTLY HARDCOPY AND DIRECT-TO-PLOTTER
      IF( .NOT.LVIDEO .AND. KOUTPT.EQ.0 ) CALL HPOUT
C *
C *  TERMINATE IF NOT HARDCOPY DEFAULT
      IF(.NOT.LDHARD) CALL END(0.0)
C *
C *  DETERMINE IF A MENU SELECTION WAS CHOSEN FROM THE VIDEO SCREEN
C *  VIDEO INPUT MAY HAVE RETURNED REDRAW CODE
      IF(IRET.EQ.99) GO TO 3000
C *  ADJUST AXES
      IF(IRET.EQ.98) THEN
        QANS = 'A'
        GO TO 6100
      ENDIF
C *  ADD MORE DATA
      IF(IRET.EQ.97) THEN
        QANS = 'M'
        GO TO 6100
      ENDIF
C *
C **  ANOTHER PLOT OR QUIT OR...
C *
C *  RESET GRAPHICS MODE TO DEFAULTS
6000  IF(LDHARD) THEN
        KDEVIC = 1
        LVIDEO = .FALSE.
       ELSE
        KDEVIC = 0
        LVIDEO = .TRUE.
      ENDIF
C *
C *  TURN OFF REDRAW MODE
      LREDRW = .FALSE.
C *
C *  NEXT COURSE OF ACTION...
6005  IF(KMODEO.EQ.0) WRITE(ITTO,6010)
6010  FORMAT(/,' Your options at this point are:',//,
     1' N - Create a new plot    M - Add more data         ',
     1'A - Adjust the axes',/,
     1' H - Make a hardcopy      S - Plot on the screen    ',
     1'C - Change files plot params',/,
     1' E - Exit the program',//,
     1'$Choice? ')
      READ(ITTI,1060) QANS
      IF(KMODEO.EQ.1) WRITE(ITTO,6012) QANS
6012  FORMAT(/,
     1' (E)XIT, (M)-ADD, (N)EW PLOT, (H)ARDCOPY OR (S)CREEN',
     1' REDRAW, (A)XIS: ',A1)
C *
C *  IF THE CHOICE IS EXIT... FINISH UP AND EXIT
6100  IF( QANS.EQ.'E' .OR. QANS.EQ.'e' ) THEN
        IF( LDHARD .AND. .NOT.LAXGET ) CALL END(0.0)
        GO TO 9000
      ENDIF
C *
C *  IF THE CHOICE IS NEW AXES... START OVER AGAIN
      IF( QANS.EQ.'N' .OR. QANS.EQ.'n' ) THEN
        IF( LDHARD .AND. .NOT.LAXGET ) CALL END(0.0)
        GO TO 1010
      ENDIF
C *
C *  CAN'T LET THE USER BEYOND HERE IF NO DATA DRAWN YET
      IF(LAXGET) THEN
        WRITE(ITTO,6110)
6110    FORMAT(
     1  ' -Your only possible choices are (E)xit or (N)ew plot.',/,
     1  '  Please choose the appropriate function.')
        GO TO 6005
      ENDIF
C *
C *  IF THE CHOICE IS ADD DATA... START WITH FILE SPECS
      IF( QANS.EQ.'M' .OR. QANS.EQ.'m' ) THEN
        LMORE = .TRUE.
        GO TO 1020
      ENDIF
C *
C *  IF THE CHOICE IS SCREEN REDRAW...
      IF( QANS.EQ.'S' .OR. QANS.EQ.'s' ) THEN
        LVIDEO = .TRUE.
        KDEVIC = 0
        LREDRW = .TRUE.
        GO TO 3000
      ENDIF
C *
C *  IF THE CHOICE IS HARDCOPY....
      IF( QANS.EQ.'H' .OR. QANS.EQ.'h' ) THEN
        LVIDEO = .FALSE.
        KDEVIC = 1
        LREDRW = .TRUE.
        IF(KOUTPT.NE.0) THEN
          QNAME = QFLNAM(1)
          QEXT(3:3) = CHAR( ICHAR('A') + MIN(IDNUMB,25) )
          IDNUMB = IDNUMB + 1
          IDCHAR = NPARSF( QNAME, QHPSTO, QEXT )
          WRITE(QNFMT,3010) IDCHAR
          WRITE(ITTO,QFMT) QHPSTO(1:IDCHAR)
          READ(ITTI,3020) QNAME
          IF( QNAME.NE.' ' .AND. QNAME.NE.'/' ) THEN
           QHPSTO = QNAME
           IDNUMB = IDNUMB - 1
          ENDIF
          INQUIRE(FILE=QHPSTO,EXIST=EXISTS)
          IF(EXISTS) THEN
            OPEN(UNIT=1,FILE=QHPSTO,STATUS='OLD')
            CLOSE(UNIT=1,STATUS='DELETE')
            WRITE(ITTO,3030)
          ENDIF
          LHPFIL = .TRUE.
        ENDIF
        GO TO 3000
      ENDIF
C *
C *  IF THE CHOICE IS ADJUST THE AXIS SYSTEM...
      IF( QANS.EQ.'A' .OR. QANS.EQ.'a' ) THEN
        LAXGET = .TRUE.
        CALL GETAXS( LAXGET )
        LAXGET = .FALSE.
        IF(LDHARD) GO TO 6000
        LVIDEO = .TRUE.
        KDEVIC = 0
        LREDRW = .TRUE.
        GO TO 3000
      ENDIF
C *
C *  IF THE CHOICE IS CHANGE A FILES DATA-GROUP PLOTTING PARAMETERS
      IF( QANS.EQ.'C' .OR. QANS.EQ.'c' ) THEN
        IF(LDHARD) THEN
          WRITE(ITTO,6044)
6044      FORMAT(/,' --You can only do this if plotting on the screen.')
          GO TO 6000
        ENDIF
        WRITE(ITTO,6046) (I,QFLNAM(I),I=1,KFLTOT)
6046    FORMAT(/,' The current files in use are:',/,(1X,I2,' - ',A64))
        WRITE(ITTO,6048)
6048    FORMAT(/,
     1  '$Which file''s parameters do you want to change? <No change> ')
        KFLCUR = 0
        READ(ITTI,*) KFLCUR
        IF( KFLCUR.LT.1 .OR. KFLCUR.GT.KFLTOT ) GO TO 6000
        KTEMP = KFLTOT
        KFLTOT = -1
        IF(KFLTYP(KFLCUR).EQ.0) THEN
          CALL INIPAT( FILEOK, LAXGET, .FALSE. )
        ELSE
          CALL INIPLT( FILEOK, LAXGET, .FALSE. )
        ENDIF
        CLOSE(UNIT=IDFI)
        KFLTOT = KTEMP
        GO TO 6000
      ENDIF
C *
C *  REPLY NOT VALID
      GO TO 6000
C *
C *  THATS ALL...
9000  WRITE(ITTO,9010)
9010  FORMAT(/,' *  Normal termination of XRDPLT  *')
      STOP
      END
C ***  BLOCK DATA
C *
      BLOCK DATA
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
C *  LOGICAL I/O UNITS
      DATA ITTI,ITTO,IDFI / 5, 6, 20 /
C *
C *  X AXIS LABELS
      DATA QXAXID ( 1),NXAXID( 1) /'Two-theta *degrees*       ', -19 /
      DATA QXAXID ( 2),NXAXID( 2) /'4.0 * Sin(Theta)          ', -16 /
      DATA QXAXID ( 3),NXAXID( 3) /'Sin^2(psi)                ', -10 /
      DATA QXAXID ( 4),NXAXID( 4) /'                          ',   0 /
C *
C *  Y AXIS LABELS
      DATA QYAXID( 1),NYAXID( 1) /'Intensity *CPS*           ',  15 /
      DATA YAXZRO( 1)            / 0.0                              /
      DATA QYAXID(11),NYAXID(11) /'CPS                       ',   3 /
      DATA YAXZRO(11)            / 0.0                              /
      DATA QYAXID( 2),NYAXID( 2) /'Two-Theta Error           ',  15 /
      DATA YAXZRO( 2)            / 0.0                              /
      DATA QYAXID(12),NYAXID(12) /'2Theta Err                ',  10 /
      DATA YAXZRO(12)            / 0.0                              /
      DATA QYAXID( 3),NYAXID( 3) /'Parameter value           ',  15 /
      DATA YAXZRO( 3)            / 0.0                              /
      DATA QYAXID(13),NYAXID(13) /'Value                     ',   5 /
      DATA YAXZRO(13)            / 0.0                              /
      DATA QYAXID( 4),NYAXID( 4) /'Beta*Cos(Theta) *Degrees* ',  25 /
      DATA YAXZRO( 4)            / 0.0                              /
      DATA QYAXID(14),NYAXID(14) /'B*Cos(Theta)              ',  12 /
      DATA YAXZRO(14)            / 0.0                              /
      DATA QYAXID( 5),NYAXID( 5) /'d-space                   ',   7 /
      DATA YAXZRO( 5)            / 0.0                              /
      DATA QYAXID(15),NYAXID(15) /'d-space                   ',   7 /
      DATA YAXZRO(15)            / 0.0                              /
      DATA QYAXID( 6),NYAXID( 6) /'A2/A1 Ratio               ',  11 /
      DATA YAXZRO( 6)            / 0.0                              /
      DATA QYAXID(16),NYAXID(16) /'A2/A1 Ratio               ',  11 /
      DATA YAXZRO(16)            / 0.0                              /
      DATA QYAXID( 7),NYAXID( 7) /'                          ',   1 /
      DATA YAXZRO( 7)            / 0.0                              /
      DATA QYAXID(17),NYAXID(17) /'                          ',   1 /
      DATA YAXZRO(17)            / 0.0                              /
C *
      END
C ***  NPARSF - PARSE FILE NAME AND TACK ON EXTENSION
C *
      FUNCTION NPARSF( QNAME1, QRTRN1, QEXT1 )
C *
      CHARACTER*1 QNAME1(64), QRTRN1(64), QEXT1(3)
C *
C *  GET LOCATION OF KEY NAME ELEMENTS AND BLANK RETURN NAME
1000  NBEG = 1
      NEND = 0
      NDOT = 0
      DO 1010 I=64,1,-1
      IF( QNAME1(I).NE.' ' .AND. NEND.EQ.0 ) NEND = I
      IF( QNAME1(I).EQ.'.' .AND. NDOT.EQ.0 ) NDOT = I
C     IF( ( QNAME1(I).EQ.'\' .OR. QNAME1(I).EQ.':' ) .AND.
C    1    NBEG.EQ.1 ) NBEG = I + 1
      QRTRN1(I) = ' '
1010  CONTINUE
      IF(NEND.GE.NBEG) GO TO 1100
      WRITE(6,1020)
1020  FORMAT(' --PARSFN: File name passed was blank, Abort')
      NPARSF = 0
      GO TO 9000
C *
C *  ENSURE THE NDOT IS DEFINED
1100  IF(NDOT.EQ.0) NDOT = NEND + 1
C *
C *  MOVE THE FILE NAME TO THE RETURN AREA
1200  NPARSF = 0
      DO 1210 I=NBEG,NDOT
      NPARSF = NPARSF + 1
      QRTRN1(NPARSF) = QNAME1(I)
1210  CONTINUE
      QRTRN1(NDOT) = '.'
C *
C *  APPEND THE FILE EXTENSION
      DO 1310 I=1,3
      IF(QEXT1(I).EQ.' ') GO TO 1310
      NPARSF = NPARSF + 1
      QRTRN1(NPARSF) = QEXT1(I)
1310  CONTINUE
C *
C *  TASK COMPLETE
9000  RETURN
      END
C ***  LOWTUP - CONVERT CHARACTERS FROM LOWER TO UPPER CASE
C *
      SUBROUTINE LOWTUP( QS, NCHAR )
      CHARACTER QS(NCHAR)*1
C *
      DO 1000 I=1,NCHAR
      IQS = ICHAR( QS(I) )
1000  IF( IQS.GT.96 .AND. IQS.LT.123 ) QS(I) = CHAR( IQS - 32 )
C *
      RETURN
      END
C ***  DATE - DUMMY ROUTINE
C *    LIMIT TO 9 CHARACTERS.  USED ONLY AS A TIME STAMP.
C *
C      SUBROUTINE DATE( QDATE )
C      CHARACTER QDATE*9
C      INTEGER*2 IYEAR,IMONTH,IDAY
C      CHARACTER QMONTH(12)*3
C      DATA QMONTH/ 'Jan','Feb','Mar','Apr','May','Jun',
C     1             'Jul','Aug','Sep','Oct','Nov','Dec'/
C      CALL GETDAT( IYEAR, IMONTH, IDAY )
C      IYEAR = IYEAR - 1900
C      WRITE(QDATE,1) IDAY,IYEAR
C1     FORMAT(I2,'-',3X,'-',I2)
C      QDATE(4:6) = QMONTH(IMONTH)
C      RETURN
C      END
C ***  TIME - DUMMY ROUTINE
C *    LIMIT TO 8 CHARACTERS.  USED ONLY AS A TIME STAMP.
C *
C      SUBROUTINE TIME( QTIME )
C      CHARACTER QTIME*8
C      INTEGER*2 IH,IM,IS,IHS
C      CALL GETTIM( IH, IM, IS, IHS )
C      WRITE(QTIME,1) IH,IM,IS
C1     FORMAT(I2,':',I2,':',I2)
C      IF(QTIME(4:4).EQ.' ') QTIME(4:4) = '0'
C      IF(QTIME(7:7).EQ.' ') QTIME(7:7) = '0'
C      RETURN
C      END
C ***  GETXDF - GET DEFAULTS FROM A DEFAULT FILE
C *
      SUBROUTINE GETXDF
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      PARAMETER (IDFTLU=21)
      CHARACTER QD(MXXDFT)*16
      CHARACTER QLIN40*40, QLIN01*1, QLIN16*16, QLINC*1, QLINN*10
      DIMENSION ISENSE(10)
      DIMENSION NT(MXXDFT), NV(MXXDFT), RV(MXXDFT)
      EQUIVALENCE ( QLIN40, QLIN01 ), ( QLIN40(2:17), QLIN16 )
      EQUIVALENCE ( QLIN40(18:18), QLINC ), ( QLIN40(18:27), QLINN )
      EQUIVALENCE ( NV, RV )
      ISENSE(6) = 0
C *
C *  Codewords, formats and defaults:
C *
CFormat: .........IIIIIIIIII
C*Plotting Device          0
      DATA QD(01),NT(01) / 'Plotting Device ', 1 /
      DATA NV(01) /  1 /
CFormat: .........IIIIIIIIII
C*Graphic Mode             1
      DATA QD(02),NT(02) / 'Graphic Mode    ', 1 /
      DATA NV(02) / 1 /
CFormat: .........IIIIIIIIII
C*HP Commands              0
      DATA QD(03),NT(03) / 'HP Commands     ', 1 /
      DATA NV(03) / 0 /
CFormat: .........IIIIIIIIII
C*HP Pen Speed            20
      DATA QD(04),NT(04) / 'HP Pen Speed    ', 1 /
      DATA NV(04) / 20 /
CFormat: .........IIIIIIIIII
C*Serial Port              0
      DATA QD(05),NT(05) / 'Serial Port     ', 1 /
      DATA NV(05) / 0 /
CFormat: .........IIIIIIIIII
C*Serial Baud Rate         5
      DATA QD(06),NT(06) / 'Serial Baud Rate', 1 /
      DATA NV(06) / 5 /
CFormat: .........IIIIIIIIII
C*Serial Parity            0
      DATA QD(07),NT(07) / 'Serial Parity   ', 1 /
      DATA NV(07) / 0 /
CFormat: .........IIIIIIIIII
C*Serial Stop Bits         0
      DATA QD(08),NT(08) / 'Serial Stop Bits', 1 /
      DATA NV(08) / 0 /
CFormat: .........IIIIIIIIII
C*Serial Character         3
      DATA QD(09),NT(09) / 'Serial Character', 1 /
      DATA NV(09) / 3 /
CFormat: .........IIIIIIIIII
C*Plot File Type           0
      DATA QD(10),NT(10) / 'Plot File Type  ', 1 /
      DATA NV(10) /  0 /
CFormat: .........IIIIIIIIII
C*PltFil Y Ovrride         1
      DATA QD(11),NT(11) / 'PltFil Y Ovrride', 1 /
      DATA NV(11) /  1 /
CFormat: .........RRRRRRRRRR
C*Y axis min value         0
      DATA QD(12),NT(12) / 'Y axis min value', 2 /
      DATA RV(12) / 0.0 /
CFormat: .........RRRRRRRRRR
C*Y axis max value       -99
      DATA QD(13),NT(13) / 'Y axis max value', 2 /
      DATA RV(13) / -99.0 /
C *
C *  SET THE DEFAULTS FOR ALL PARAMETERS
900   DO 910 I=1,MXXDFT
      IF(NT(I).EQ.1) THEN
        KXDFTI(I) = NV(I)
       ELSE
        PXDFTI(I) = RV(I)
      ENDIF
910   CONTINUE
C *
C *  OPEN THE FILE CONTAINING THE DEFAULT PARAMETERS
1000  OPEN(UNIT=IDFTLU,FILE='XRDPLT.DFT',STATUS='OLD',ERR=1010)
      GO TO 1100
1010  WRITE(ITTO,1020)
1020  FORMAT(//,
     1' --Can not find the file containing the plotting parameter',
     1' defaults.',/,
     1'   You will be supplied the set of defaults described in the',
     1' User''s Guide.',/,
     1'   Copy the XRDPLT.DFT file from your distribution disk to',
     1' your working',/,
     1'   disk.  Edit XRDPLT.DFT to reflect your needs.')
      GO TO 9000
C *
C *  SEARCH FOR LINES CONTAINING THE CORRECT KEYWORDS
1100  READ(IDFTLU,1110,END=1900) QLIN40
1110  FORMAT(A40)
C      WRITE(6,1112) QLIN40
C1112  FORMAT(1X,A40)
      IF(QLIN01.NE.'*') GO TO 1100
C *
C *  MARKER FOUND.  GET SUSPECT STRING AND CHECK KEYWORD LIST FOR MATCH
1200  IF(ISENSE(6).NE.0) WRITE(6,1202) QLIN16
1202  FORMAT(/,' GETXDF: Looking for a keyword in "',A16,'"')
      DO 1210 I=1,MXXDFT
1210  IF(QD(I).EQ.QLIN16) GO TO 1300
      WRITE(6,1220) QLIN16
1220  FORMAT(//,' --Error while reading XRDPLT.DFT:',
     1'  Unrecognizable keyword "',A16,'"')
      GO TO 1100
C *
C *  KEYWORD FROM LIST FOUND.  OBTAIN THE PARAMETER VALUE.
1300  READ(QLINN,1310,ERR=1390) RSVP
1310  FORMAT(F10.0)
      IF(NT(I).EQ.1) THEN
        KXDFTI(I) = NINT( RSVP )
        IF(ISENSE(6).NE.0) WRITE(6,1312) I,KXDFTI(I)
1312    FORMAT(' Variable',I2,': Parameter value = ',I7)
       ELSE IF(NT(I).EQ.2) THEN
        PXDFTI(I) = RSVP
        IF(ISENSE(6).NE.0) WRITE(6,1314) I,PXDFTI(I)
1314    FORMAT(' Variable',I2,': Parameter value = ',F14.7)
       ELSE
        WRITE(ITTO,1316) QLIN16
1316    FORMAT(
     1  ' --GETXDF: Invalid parameter type for ',A16,' (program error)')
        GO TO 1100
      ENDIF
      GO TO 1100
1390  WRITE(6,1392) QLIN40
1392  FORMAT(//,
     1' --The value for the keyword in the following phrase could not',
     1' be parsed:',/,
     13X,'"',A40,'"  Please check the XRDPLT.DFT',/,
     1'   file and make the value correspond to the given format.')
      GO TO 1100
C *
C *  EOF HIT.  CLOSE FILE
1900  CLOSE(UNIT=IDFTLU)
C *
C **  LIMITS AND PARAMETER VALUE ASSIGNMENT
C *
C *  PLOTTING DEVICE
2000  IF( KXDFTI(01).LT.0 .OR. KXDFTI(01).GT.1 ) THEN
        WRITE(6,2010) QD(01),NV(01)
2010    FORMAT(//,
     1  ' -Error while reading XRDPLT.DFT:  The  value for "',A16,'"',/,
     1  '  was out of range.  Using default = ',I10)
2020    FORMAT(//,
     1  ' -Error while reading XRDPLT.DFT:  The value for "',A16,'"',/,
     1  '  was out of range.  Using default = ',G14.7)
        KXDFTI(01) = NV(01)
      ENDIF
      KDEVIC = KXDFTI(01)
C *
C *  GRAPHICS MODE
      IF( KXDFTI(02).LT.0 .OR. KXDFTI(02).GT.4 ) THEN
        WRITE(6,2010) QD(02),NV(02)
        KXDFTI(02) = NV(02)
      ENDIF
      MODEVG = KXDFTI(02)
C *
C *  HP COMMAND OUTPUT
      IF( KXDFTI(03).NE.0 .AND. KXDFTI(03).NE.1 ) THEN
        WRITE(6,2010) QD(03),NV(03)
        KXDFTI(03) = NV(03)
      ENDIF
      KOUTPT = KXDFTI(03)
C *
C *  HP PEN SPEED
      IF( KXDFTI(04).LT.1 .OR. KXDFTI(04).GT.36 ) THEN
        WRITE(6,2010) QD(04),NV(04)
        KXDFTI(04) = NV(04)
      ENDIF
      KHPSPD = KXDFTI(04)
C *
C *  SERIAL COMMUNICATION PORT
      IF( KXDFTI(05).LT.0 .OR. KXDFTI(05).GT.4 ) THEN
        WRITE(6,2010) QD(05),NV(05)
        KXDFTI(05) = NV(05)
      ENDIF
      KCMPRM(1) = KXDFTI(05)
C *
C *  SERIAL PORT BAUD RATE
      IF( KXDFTI(06).LT.0 .OR. KXDFTI(06).GT.7 ) THEN
        WRITE(6,2010) QD(06),NV(06)
        KXDFTI(06) = NV(06)
      ENDIF
      KCMPRM(2) = KXDFTI(06)
C *
C *  SERIAL PORT PARITY
      IF(KXDFTI(07).NE.0.AND.KXDFTI(07).NE.1.AND.KXDFTI(07).NE.3) THEN
        WRITE(6,2010) QD(07), NV(07)
        KXDFTI(07) = NV(07)
      ENDIF
      KCMPRM(3) = KXDFTI(07)
C *
C *  SERIAL PORT STOP BITS
      IF( KXDFTI(08).NE.0 .AND. KXDFTI(08).NE.1 ) THEN
        WRITE(6,2010) QD(08),NV(08)
        KXDFTI(08) = NV(08)
      ENDIF
      KCMPRM(4) = KXDFTI(08)
C *
C *  SERIAL PORT CHARACTER LENGTH
      IF( KXDFTI(09).NE.2 .AND. KXDFTI(09).NE.3 ) THEN
        WRITE(6,2010) QD(09),NV(09)
        KXDFTI(09) = NV(09)
      ENDIF
      KCMPRM(5) = KXDFTI(09)
C *
C *  DEFAULT PLOT FILE TYPE: 0-UNFORMATTED, 1-FORMATTED
      IF( KXDFTI(10).LT.0 .OR. KXDFTI(10).GT.1 ) THEN
        WRITE(6,2010) QD(10),NV(10)
        KXDFTI(10) = NV(10)
      ENDIF
      KFLPDT = KXDFTI(10)
C *
C *  OVERRIDE PLOT FILE Y MINIMUM AND MAXIMUM VALUES
      IF( KXDFTI(11).LT.0 .OR. KXDFTI(11).GT.1 ) THEN
        WRITE(6,2010) QD(11),NV(11)
        KXDFTI(11) = NV(11)
      ENDIF
C *
C *  DEFAULT Y AXIS MINIMUM VALUE: ANY VALUE IS ALLOWED: NO CHECK
C *
C *  DEFAULT Y AXIS MAXIMUM VALUE: ANY VALUE IS ALLOWED: NO CHECK
C *
C *  EXIT STAGE LEFT
9000  RETURN
      END
C ***  INIPLT - INITIALIZE FOR PLOTTING BINARY FILE
C *
      SUBROUTINE INIPLT( FILEOK, LAXGET, LRESET )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      LOGICAL FILEOK,LMARKS,LAXGET,LCHNGE,LNEW,LRESET
      CHARACTER QNTITL*20,QPLFHD*78
      CHARACTER QANS*1,QFTITL*80
C *
C *   LNEW INDICATES NEW PLOT FILE
      LNEW = KFLCUR .GT. KFLTOT
C *
C *   MARKERS IN DATA FLAG
      LMARKS = .FALSE.
C *
C **  GET THE FILE NAME
C *
C *  GET NAME ONLY IF THIS IS A NEW PLOT FILE
1000  IF( .NOT.LNEW .OR. KFLTOT.EQ.-1 ) GO TO 1100
C *
C *  GET THE NAME
      IF(KMODEO.EQ.0) WRITE(ITTO,1010)
1010  FORMAT(/,'$Plot file name? <Next file> ')
      READ(ITTI,1020) QFLNAM(KFLCUR)
1020  FORMAT(A64)
      CALL LOWTUP( QFLNAM(KFLCUR), 64 )
      IF(KMODEO.EQ.1) WRITE(ITTO,1022) QFLNAM(KFLCUR)
1022  FORMAT('  PLOT FILE NAME: ',A64)
      KFLFRM(KFLCUR) = KFLPDT
      N = INDEX( QFLNAM(KFLCUR), '/U' )
      IF(N.GT.0) THEN
        WRITE(ITTO,1030)
1030    FORMAT(/,' -Input file type set to unformatted')
        KFLFRM(KFLCUR) = 0
        QFLNAM(KFLCUR)(N:N+1) = '  '
      ENDIF
      N = INDEX( QFLNAM(KFLCUR), '/F' )
      IF(N.GT.0) THEN
        WRITE(ITTO,1032)
1032    FORMAT(/,' -Input file type set to formatted')
        KFLFRM(KFLCUR) = 1
        QFLNAM(KFLCUR)(N:N+1) = '  '
      ENDIF
      FILEOK = QFLNAM(KFLCUR)(1:1).NE.' ' .AND.
     1         QFLNAM(KFLCUR)(1:1).NE.'/'
      IF(.NOT.FILEOK) GO TO 9000
C *
C *  OPEN THE REQUESTED PLOT FILE
1100  IF(KFLFRM(KFLCUR).EQ.0) THEN
        OPEN(IDFI,FILE=QFLNAM(KFLCUR),STATUS='OLD',FORM='UNFORMATTED',
     1   ERR=1110)
       ELSE
        OPEN(IDFI,FILE=QFLNAM(KFLCUR),STATUS='OLD',FORM='FORMATTED',
     1   ERR=1110)
      ENDIF
C *
C *  INDICATE THE FILE MIN AND MAX VALUES NEED TO BE DETERMINED
      KASCFC(KFLCUR) = 0
C *
      GO TO 2000
C *
C *  AN ERROR OCCURED ON FILE OPENING
1110  FILEOK = .FALSE.
      WRITE(ITTO,1120)
1120  FORMAT(/,' --Specified file busy or not there: try again.')
      GO TO 9000
C *
C **  READ THE INITIAL PLOT INFORMATION
C *
2000  IF(KFLFRM(KFLCUR).EQ.0) THEN
        READ(IDFI) QPLFHD
        READ(IDFI) QFTITL
        READ(IDFI) XSCALE,JAXBOX,JAXDRW
        READ(IDFI) JXAXID,XAXOR,XAXLN,XAXST,XAXEN,XAXDV
        READ(IDFI) JYAXID,YAXOR,YAXLN,YAXST,YAXEN,YAXDV
        READ(IDFI) KDGNUM(KFLCUR)
       ELSE
        READ(IDFI,2010) QPLFHD
2010    FORMAT(A78)
        READ(IDFI,2020) QFTITL
2020    FORMAT(A80)
        READ(IDFI,2030) XSCALE,JAXBOX,JAXDRW
2030    FORMAT(F9.0,2I9)
        READ(IDFI,2040) JXAXID,XAXOR,XAXLN,XAXST,XAXEN,XAXDV
        READ(IDFI,2040) JYAXID,YAXOR,YAXLN,YAXST,YAXEN,YAXDV
2040    FORMAT(I9,5F9.0)
        READ(IDFI,2050) KDGNUM(KFLCUR)
2050    FORMAT(I9)
      ENDIF
      IF(LNEW) WRITE(ITTO,2060) QFTITL(1:72),XAXST,XAXEN
2060  FORMAT(/,' * The run time data on file are as follows:',//,
     1 1X,A72,//,
     1 ' Starting angle ',F8.4,'   Ending angle ',F8.4)
C *
C *  IF NEW AXES THEN SET THE PLOT PARAMETERS TO THOSE READ FROM THE FILE
      IF(LAXGET) THEN
        QPLTID = QFTITL
        KAXBOX = JAXBOX
CNEW    KAXDRW = JAXDRW
        KXAXID = JXAXID
        XAXBEG = XAXST
        XAXEND = XAXEN
        XAXDEL = XAXDV
        KYAXID = JYAXID
        IF(KXDFTI(11).EQ.0) THEN
          YAXBEG = YAXST
          YAXEND = YAXEN
          KASCYL = 0
          KASCYH = 0
        ENDIF
        YAXDEL = YAXDV
      ENDIF
C *
C **  GROUP PLOTTING INFO
C *
C *  GET THE GROUP PARAMETERS AND SET ASSOCIATED PARAMETERS
3000  DO 3010 I=1,KDGNUM(KFLCUR)
      IF(KFLFRM(KFLCUR).EQ.0) THEN
        READ(IDFI)      QNTITL,I1,X1,I2,I3,X2
       ELSE
        READ(IDFI,3020) QNTITL,I1,X1,I2,I3,X2
3020    FORMAT(A20,I9,F9.2,2I9,F9.4)
      ENDIF
      IF( .NOT.LNEW .OR. .NOT.LRESET ) GO TO 3010
      QDGTTL(KFLCUR,I)   = QNTITL
      KDGFRQ(KFLCUR,I)   =  I1
      PDGOFS(KFLCUR,I)   =  X1
      KDGPEN(KFLCUR,I)   =  I2
      KDGTYP(KFLCUR,I)   =  I3
      PDGINC(KFLCUR,I)   =  X2
      KDGUSD(KFLCUR,I)   =   0
      PDGLXY(KFLCUR,I,1) = 0.0
      PDGLXY(KFLCUR,I,2) = 0.0
      PDGLXY(KFLCUR,I,3) = 0.0
      IF( KDGTYP(KFLCUR,I).EQ. 1 ) THEN
        IF( KDGFRQ(KFLCUR,I) .LT. 0 ) THEN
          KDGSYM(KFLCUR,I) = KDGSYN
          KDGSYN = KDGSYN + 1
          IF(KDGSYN.GT.11) KDGSYN = 1
         ELSE
          KDGSYM(KFLCUR,I) = 0
        ENDIF
      ENDIF
3010  CONTINUE
C *
C *  FILE RELATED PARAMETERS
      IF( .NOT.LNEW .OR. .NOT.LRESET ) GO TO 3050
      PSLSIZ(KFLCUR) = 0.0
      KSLTYP(KFLCUR) =   0
C *
C **  EXIT NOW IF NOT A NEW FILE- CAN NOT ALLOW CHANGES
C *
3050  IF( .NOT.LNEW ) GO TO 9000
C *
C **  PRINT FOR USER AND ALLOW CHANGES
C *
4000  WRITE(ITTO,4010)
4010  FORMAT(/,' *   Specification of the data group attributes:')
4020  WRITE(ITTO,4030)
4030  FORMAT(/,' The plotting parameters for the data groups are:',//,
     1' Group                         Plot  Y axis',/
     1' number  Group label           freq  offset  Pen  Symbol',
     1'  Data type   ',/
     1' ------  --------------------  ----  ------  ---  ------',
     1'  ------------')
      DO 4040 I=1,KDGNUM(KFLCUR)
      IF(KDGTYP(KFLCUR,I).EQ.0) THEN
        WRITE(ITTO,4050) I,QDGTTL(KFLCUR,I),KDGFRQ(KFLCUR,I),
     1    PDGOFS(KFLCUR,I),KDGPEN(KFLCUR,I),'Pattern data'
4050    FORMAT(2X,I2,5X,A20,1X,I3,4X,F5.2,3X,I2,3X,' n/a',4X,A12)
       ELSE IF(KDGTYP(KFLCUR,I).EQ.1) THEN
        WRITE(ITTO,4060) I,QDGTTL(KFLCUR,I),KDGFRQ(KFLCUR,I),
     1    PDGOFS(KFLCUR,I),KDGPEN(KFLCUR,I),KDGSYM(KFLCUR,I),
     1    'Data Points '
4060    FORMAT(2X,I2,5X,A20,1X,I3,4X,F5.2,3X,I2,3X,I4,4X,A12)
       ELSE IF(KDGTYP(KFLCUR,I).EQ.2) THEN
        WRITE(ITTO,4050) I,QDGTTL(KFLCUR,I),KDGFRQ(KFLCUR,I),
     1    PDGOFS(KFLCUR,I),KDGPEN(KFLCUR,I),'Markers     '
        LMARKS = .TRUE.
       ELSE IF(KDGTYP(KFLCUR,I).EQ.3) THEN
        WRITE(ITTO,4050) I,QDGTTL(KFLCUR,I),KDGFRQ(KFLCUR,I),
     1    PDGOFS(KFLCUR,I),KDGPEN(KFLCUR,I),'Vrt Err bars'
       ELSE IF(KDGTYP(KFLCUR,I).EQ.4) THEN
        WRITE(ITTO,4050) I,QDGTTL(KFLCUR,I),KDGFRQ(KFLCUR,I),
     1    PDGOFS(KFLCUR,I),KDGPEN(KFLCUR,I),'Hor Err bars'
       ELSE
        WRITE(ITTO,4050) I,QDGTTL(KFLCUR,I),KDGFRQ(KFLCUR,I),
     1    PDGOFS(KFLCUR,I),KDGPEN(KFLCUR,I),'Unknown     '
        WRITE(ITTO,4070)
4070    FORMAT(' --INIPLT:  The data type for this group is unknown;',
     1    ' Expect problems.')
        KDGFRQ(KFLCUR,I) = 0
      ENDIF
4040  CONTINUE
C *
C *  ALLOW CHANGES IN PARAMETERS
C *
4100  LCHNGE = .FALSE.
4110  IF(KMODEO.EQ.0) THEN
4120    WRITE(ITTO,4130)
4130    FORMAT(/,
     1'$Changes?  Enter: GROUP #, FREQ, OFFSET, PEN # <No change> ')
        IGRO = 0
        IPLO = 0
        XOFF = 0.0
        IPEN = 0
        READ(ITTI,*,ERR=4120) IGRO,IPLO,XOFF,IPEN
       ELSE IF(KMODEO.EQ.1) THEN
        READ(ITTI,4140) IGRO,IPLO,XOFF,IPEN
4140    FORMAT(I6,I6,F6.2,I6)
      ENDIF
      IF( IGRO.EQ.0 .AND.      LCHNGE ) GO TO 4000
      IF( IGRO.EQ.0 .AND. .NOT.LCHNGE ) GO TO 5000
      IF( IGRO.LT.1 .OR. IGRO.GT.KDGNUM(KFLCUR) ) GO TO 4110
      LCHNGE = .TRUE.
      KDGFRQ(KFLCUR,IGRO) = IPLO
      PDGOFS(KFLCUR,IGRO) = XOFF
      KDGPEN(KFLCUR,IGRO) = IPEN
      KASCFC(KFLCUR)      = 0
      IF( IPLO.EQ.0 .OR. IPEN.EQ.0 ) THEN
        WRITE(ITTO,4150)
4150    FORMAT(' -Data group will not be drawn: Frequency or pen = 0')
        GO TO 4110
      ENDIF
      IF(KMODEO.EQ.0) WRITE(ITTO,4160)
4160  FORMAT('$ New group id? (*=skip label) <No change> ')
      READ(ITTI,4170) QNTITL
4170  FORMAT(A20)
      IF(QNTITL.NE.' '.AND.QNTITL.NE.'/') QDGTTL(KFLCUR,IGRO) = QNTITL
      IF(KDGTYP(KFLCUR,IGRO).EQ.1) THEN
4180    WRITE(ITTO,4182) KDGSYM(KFLCUR,IGRO)
4182    FORMAT('$ New symbol number? (0=No symbol) <',I2,'> ')
        ITEMP = KDGSYM(KFLCUR,IGRO)
        READ(ITTI,*,ERR=4180) ITEMP
        IF(ITEMP.GE.0) KDGSYM(KFLCUR,IGRO) = ITEMP
      ENDIF
      GO TO 4110
C *
C **  DETERMINE THE ANNOTATION FOR THE STICK MARKERS
C *
5000  IF(.NOT.LMARKS) GO TO 9000
      IF( KSLTYP(KFLCUR) .EQ. 0 ) QNTITL(1:1) = 'N'
      IF( KSLTYP(KFLCUR) .EQ. 1 ) QNTITL(1:1) = 'S'
      IF( KSLTYP(KFLCUR) .EQ. 2 ) QNTITL(1:1) = 'T'
      IF( KSLTYP(KFLCUR) .EQ. 3 ) QNTITL(1:1) = 'D'
      IF(KMODEO.EQ.0) WRITE(ITTO,5010) QNTITL(1:1)
5010  FORMAT(/,
     1' Designate the annotation for use with the stick markers:',/,
     1'$  (S)erial number, (T)wo-theta, (D)-spacing, (N)one? <',A1,'> ')
      READ(ITTI,5020) QANS
5020  FORMAT(A1)
      IF( QANS.EQ.' ' .OR. QANS.EQ.'/' ) QANS = QNTITL(1:1)
      IF( QANS.EQ.'N' .OR. QANS.EQ.'n' ) KSLTYP(KFLCUR) = 0
      IF( QANS.EQ.'S' .OR. QANS.EQ.'s' ) KSLTYP(KFLCUR) = 1
      IF( QANS.EQ.'T' .OR. QANS.EQ.'t' ) KSLTYP(KFLCUR) = 2
      IF( QANS.EQ.'D' .OR. QANS.EQ.'d' ) KSLTYP(KFLCUR) = 3
      IF(KMODEO.EQ.1) THEN
        IF(KSLTYP(KFLCUR).EQ.0) WRITE(ITTO,5030)
5030    FORMAT(/,' No annotation put on line markers')
        IF(KSLTYP(KFLCUR).EQ.1) WRITE(ITTO,5032)
5032    FORMAT(/,' Index numbers written above line markers')
        IF(KSLTYP(KFLCUR).EQ.2) WRITE(ITTO,5034)
5034    FORMAT(/,' Two-thetas written above line markers')
        IF(KSLTYP(KFLCUR).EQ.3) WRITE(ITTO,5036)
5036    FORMAT(/,' D-spacings written above line markers')
      ENDIF
      IF(PSLSIZ(KFLCUR).LT.0.1) PSLSIZ(KFLCUR) = 0.0
      IF(KMODEO.EQ.0) WRITE(ITTO,5040) PSLSIZ(KFLCUR)
5040  FORMAT(
     1'$ Marker size in inches?  (0=Use values from file) <',F3.1,'> ')
      READ(ITTI,*) PSLSIZ(KFLCUR)
      IF(PSLSIZ(KFLCUR).LT.0.1) PSLSIZ(KFLCUR) = 0.0
      IF(KMODEO.EQ.1) WRITE(ITTO,5050) PSLSIZ(KFLCUR)
5050  FORMAT(/,
     1' Marker size in inches (0=file values to be used) = ',F5.2)
C *
C **  INFO COMPLETE
9000  RETURN
      END
C ***  INIPAT - INITIALIZE FOR PLOTTTING RAW DATA FILE
C *
      SUBROUTINE INIPAT( FILEOK, LAXGET, LRESET )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      LOGICAL FILEOK,LNEW,LAXGET,LRESET
      CHARACTER QDATE*9,QTIME*8
      CHARACTER QANS*1,QFTITL*80
C *
C *   LNEW INDICATES NEW PATTERN
      LNEW = KFLCUR .GT. KFLTOT
C *
C **  OPEN THE INPUT DATA FILE
C *
C *  GET THE FILE NAME AND TYPE ONLY IF THIS IS A NEW PATTERN
      IF( .NOT.LNEW .OR. KFLTOT.EQ.-1 ) GO TO 1100
C *
C *  GET THE DATA FILE NAME... QUIT IF BLANK
1000  IF(KMODEO.EQ.0) WRITE(ITTO,1010)
1010  FORMAT(/,'$Pattern file name? <Next file> ')
      READ(ITTI,1020) QFLNAM(KFLCUR)
1020  FORMAT(A64)
      CALL LOWTUP( QFLNAM(KFLCUR), 64 )
      IF(KMODEO.EQ.1) WRITE(ITTO,1022) QFLNAM(KFLCUR)
1022  FORMAT('  PATTERN FILE NAME: ',A64)
      FILEOK = QFLNAM(KFLCUR)(1:1).NE.' ' .AND.
     1         QFLNAM(KFLCUR)(1:1).NE.'/'
      IF(.NOT.FILEOK) GO TO 9000
C *
C *  GET THE DATA FILE TYPE
      N = INDEX( QFLNAM(KFLCUR), '.XDB' )
      IF(N.GT.0) THEN
        QANS = 'U'
        GO TO 1051
      ENDIF
      N = INDEX( QFLNAM(KFLCUR), '.XDA' )
      IF(N.GT.0) THEN
        QANS = 'F'
        GO TO 1051
      ENDIF
1040  IF(KMODEO.EQ.0) WRITE(ITTO,1042)
1042  FORMAT('$ (F)ormatted or (U)nformatted pattern file? <F> ')
      READ(ITTI,1050) QANS
1050  FORMAT(A1)
1051  IF( QANS.EQ.'U' .OR. QANS.EQ.'u' ) THEN
        KFLFRM(KFLCUR) = 0
       ELSE
        KFLFRM(KFLCUR) = 1
      ENDIF
      IF( KMODEO.EQ.1 .AND. KFLFRM(KFLCUR).EQ.1 ) WRITE(ITTO,1052)
1052  FORMAT('  PATTERN FILE IS FORMATTED')
      IF( KMODEO.EQ.1 .AND. KFLFRM(KFLCUR).EQ.0 ) WRITE(ITTO,1054)
1054  FORMAT('  PATTERN FILE IS UNFORMATTED')
C *
C *  OPEN THE INPUT DATA FILE
1100  IF(KFLFRM(KFLCUR).EQ.1) THEN
        OPEN(UNIT=IDFI,FILE=QFLNAM(KFLCUR),STATUS='OLD',ERR=1110,
     1  FORM='FORMATTED')
       ELSE
        OPEN(UNIT=IDFI,FILE=QFLNAM(KFLCUR),STATUS='OLD',ERR=1110,
     1  FORM='UNFORMATTED')
      ENDIF
C *
C *  INDICATE THE FILE MIN AND MAX VALUES NEED TO BE DETERMINED
      KASCFC(KFLCUR) = 0
C *
      GO TO 2000
C *
C *  AN ERROR OCCURED ON FILE OPENING
1110  WRITE(ITTO,1120)
1120  FORMAT(/,' --Specified file is busy or not there: try again.')
      FILEOK = .FALSE.
      GO TO 9000
C *
C **  GET FILE PARAMETERS
C *
2000  IF(KFLFRM(KFLCUR).EQ.1) THEN
        READ(IDFI,2010) QFTITL
2010    FORMAT(A80)
        READ(IDFI,2030) QDATE,QTIME
2030    FORMAT(A9,A8)
        READ(IDFI,2050) PTBANG,PTEANG,PDGINC(KFLCUR,1),PTCTIM
2050    FORMAT(4F10.4)
       ELSE
        READ(IDFI) QFTITL
        READ(IDFI) QDATE,QTIME
        READ(IDFI) PTBANG,PTEANG,PDGINC(KFLCUR,1),PTCTIM
      ENDIF
      IF(LNEW) WRITE(ITTO,2060)
     1 QFTITL(1:72),PTBANG,PDGINC(KFLCUR,1),QDATE,PTEANG,PTCTIM,QTIME
2060  FORMAT(/,' The run time parameters for this file are:',//,
     1 1X,A72,//,
     1 ' Starting angle   ',F8.4,'   Angle increment  ',F8.4,
     1 '   Date   ',A9,/
     1 ' Ending angle     ',F8.4,'   Count time (sec) ',F8.4,
     1 '   Time    ',A8)
C *
C *  COPY FILE PARAMETER IF STARTING NEW AXES
      IF(LAXGET) THEN
        QPLTID =  QFTITL
        XAXBEG =  PTBANG
        XAXEND =  PTEANG
CDEL    YAXBEG =     0.0
CDEL    YAXEND =  1200.0
      ENDIF
C *
C *  SET THE POINTER INTO THE DATA FILE TO THE BEGINNING
      PTANXT = PTBANG
C *
C **  IF THIS IS A NEW PATTERN, GET THE PARAMETERS FOR PLOTTING
C *
C *  GET THE PARAMS ONLY IF THIS IS A NEW PATTERN
      IF(.NOT.LNEW) GO TO 9000
C *
5000  WRITE(ITTO,5002)
5002  FORMAT(/,' *  Specification of the data group attributes:')
      IF(LRESET) THEN
        KDGNUM(KFLCUR)     =   1
        KDGUSD(KFLCUR,1)   =   0
        PDGLXY(KFLCUR,1,1) = 0.0
        PDGLXY(KFLCUR,1,2) = 0.0
        PDGLXY(KFLCUR,1,3) = 0.0
        KDGTYP(KFLCUR,1)   =   0
        KDGSYM(KFLCUR,1)   =   0
        KDGFRQ(KFLCUR,1)   =   1
        PDGOFS(KFLCUR,1)   = 0.0
        KDGPEN(KFLCUR,1)   =   2
      ENDIF
      IF(KMODEO.EQ.0) WRITE(ITTO,5010)
5010  FORMAT(/,'$20 character label for this pattern? <No label> ')
      READ(ITTI,5020) QDGTTL(KFLCUR,1)
5020  FORMAT(A20)
      IF(QDGTTL(KFLCUR,1)(1:1).EQ.'/') QDGTTL(KFLCUR,1) = ' '
      IF(KMODEO.EQ.1) WRITE(ITTO,5022) QDGTTL(KFLCUR,1)
5022  FORMAT(/,' LABEL FOR THE PATTERN IS: ',A20)
      IF(KMODEO.EQ.0) THEN
5024    IT1 = KDGFRQ(KFLCUR,1)
        FT1 = PDGOFS(KFLCUR,1)
        IT2 = KDGPEN(KFLCUR,1)
        WRITE(ITTO,5026) IT1,FT1,IT2
5026    FORMAT(/,
     1  ' Enter: IFREQ  - Frequency of points to plot',
     1  ' (-N dots, +N lines)',/,
     1  '        OFFSET - Offset in inches from the bottom axis',/,
     1  '        IPEN   - Pen to use for plotting data',//,
     1  '$Codes? <',I3,',',F4.1,',',I1,'> ')
        READ(ITTI,*,ERR=5024) IT1,FT1,IT2
       ELSE IF(KMODEO.EQ.1) THEN
        READ(ITTI,5030) IT1,FT1,IT2
5030    FORMAT(I6,F6.2,I6)
      ENDIF
      IF( IT1.NE.KDGFRQ(KFLCUR,1) ) THEN
        KDGFRQ(KFLCUR,1) = IT1
        KASCFC(KFLCUR  ) =   0
      ENDIF
      IF( FT1.NE.PDGOFS(KFLCUR,1) ) THEN
        PDGOFS(KFLCUR,1) = FT1
        KASCFC(KFLCUR  ) =   0
      ENDIF
      IF( IT2.NE.KDGPEN(KFLCUR,1) .AND. IT2.GE.0 ) THEN
        KDGPEN(KFLCUR,1) = IT2
        KASCFC(KFLCUR  ) =   0
      ENDIF
      IF(KMODEO.EQ.1) THEN
        WRITE(ITTO,5032) KDGFRQ(KFLCUR,1),PDGOFS(KFLCUR,1),
     1    KDGPEN(KFLCUR,1)
5032    FORMAT(' PLOT CODE ',I2,'  OFFSET ',F5.2,'  PEN ',I1)
      ENDIF
C *
C *  EXIT STAGE RIGHT
9000  RETURN
      END
C ***  GETPLT - GET THE NEXT BUFFER FOR A PLOT FILE
C *
      SUBROUTINE GETPLT( NSET, EOFHIT )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      LOGICAL EOFHIT
      CHARACTER QJUNK*1
C *
C *  EOFHIT = FALSE  DATA SET READ
C *  EOFHIT = TRUE   EOF HIT
C *  NDVPTS =  ACTUAL NUMBER OF POINTS IN DATA SEGMENT
C *
C *  SET END-OF-FILE HIT FLAG TO FALSE
      EOFHIT = .FALSE.
C *
C **  READ THE DATA SET HEADER
C *
      IF(KFLFRM(KFLCUR).EQ.0) THEN
        READ(IDFI,END=3) NSET,NDVPTS,PDVBEG
       ELSE
        READ(IDFI,9,END=3) NSET,NDVPTS,PDVBEG
9       FORMAT(I6,I6,F10.4)
      ENDIF
      GO TO 10
1     WRITE(ITTO,2)
2     FORMAT(/,' --PREMATURE END-OF-FILE HIT:  CONTINUING')
3     EOFHIT = .TRUE.
      NDVPTS = 0
      GO TO 9000
C *
C *  ENSURE THE NUMBER OF POINTS DOES NOT EXCEED LIMIT
10    IF(NDVPTS.GT.MNPTS) THEN
        WRITE(ITTO,11) NDVPTS,MNPTS
11      FORMAT(' --NUMBER OF POINTS FOR INPUT ',I4,': LIMITED TO ',I4)
        NDVPTS = MNPTS
      ENDIF
C *
C **  READ TYPE 0 DATA, PLOTTING DATA SET
C *
1000  IF(KDGTYP(KFLCUR,NSET).NE.0) GO TO 2000
      IF(KFLFRM(KFLCUR).EQ.0) THEN
        NREC = NDVPTS / 10
        NREM = NDVPTS - NREC * 10
        NTRK = 0
        DO 1002 I=1,NREC
        READ(IDFI,END=1) ( PDVYVL(J), J=(NTRK+1),(NTRK+10) )
        NTRK = NTRK + 10
1002    CONTINUE
        IF(NREM.GT.0) THEN
          READ(IDFI,END=1) ( PDVYVL(J), J=(NTRK+1),(NTRK+NREM) )
        ENDIF
       ELSE
        READ(IDFI,1012,END=1) (PDVYVL(I),I=1,NDVPTS)
1012    FORMAT(10F8.1)
      ENDIF
C *
C *  SKIP THE DATA SET IF NOT IN PLOTTING RANGE
      PDVEND = PDVBEG + (NDVPTS-1) * PDGINC(KFLCUR,NSET)
      IF(KAXXRV.EQ.0) THEN
        IF(PDVEND.LT.XAXBEG) NDVPTS = 0
        IF(PDVBEG.GT.XAXEND) NDVPTS = 0
       ELSE
        IF(PDVEND.LT.XAXEND) NDVPTS = 0
        IF(PDVBEG.GT.XAXBEG) NDVPTS = 0
      ENDIF
      IF(NDVPTS.EQ.0) GO TO 9000
C *
C *  GENERATE ANGULAR VALUES
      TEMP = PDVBEG - PDGINC(KFLCUR,NSET)
      DO 1020 I=1,NDVPTS
1020  PDVXVL(I) = TEMP + REAL(I) * PDGINC(KFLCUR,NSET)
C *
      GO TO 9000
C *
C **  READ TYPE 1 = X-Y DATA
C *
2000  IF(KDGTYP(KFLCUR,NSET).NE.1) GO TO 3000
      IF(KFLFRM(KFLCUR).EQ.0) THEN
        DO 2002 I=1,NDVPTS
2002    READ(IDFI,END=1) PDVXVL(I),PDVYVL(I)
       ELSE
        DO 2004 I=1,NDVPTS
2004    READ(IDFI,2010,END=1) PDVXVL(I),PDVYVL(I)
2010    FORMAT(2F10.4)
      ENDIF
      PDVBEG = PDVXVL(1)
      PDVEND = PDVXVL(NDVPTS)
      GO TO 9000
C *
C **  READ TYPE 2 DATA = MARKER INFORMATION
C *
3000  IF(KDGTYP(KFLCUR,NSET).NE.2) GO TO 4000
      IF(KFLFRM(KFLCUR).EQ.0) THEN
        DO 3010 I=1,NDVPTS
3010    READ(IDFI,END=1) PDVXVL(I),PDVYVL(I),PDVVL1(I),PDVVL2(I),
     1    KDVIV1(I)
       ELSE
        DO 3012 I=1,NDVPTS
3012    READ(IDFI,3020,END=1) PDVXVL(I),PDVYVL(I),PDVVL1(I),PDVVL2(I),
     1    KDVIV1(I)
3020    FORMAT(4F10.4,I2)
      ENDIF
      PDVBEG = PDVXVL(1)
      PDVEND = PDVXVL(NDVPTS)
      GO TO 9000
C *
C **  READ TYPE 3 DATA = VERTICAL ERROR BARS
C *
4000  IF(KDGTYP(KFLCUR,NSET).NE.3) GO TO 5000
      IF(KFLFRM(KFLCUR).EQ.0) THEN
        DO 4010 I=1,NDVPTS
4010    READ(IDFI,END=1) PDVXVL(I),PDVYVL(I),PDVVL1(I)
       ELSE
        DO 4012 I=1,NDVPTS
4012    READ(IDFI,4020,END=1) PDVXVL(I),PDVYVL(I),PDVVL1(I)
4020    FORMAT(3F10.4)
      ENDIF
      PDVBEG = PDVXVL(1)
      PDVEND = PDVXVL(NDVPTS)
      GO TO 9000
C *
C **  READ TYPE 4 DATA = HORIZONTAL ERROR BARS
C *
5000  IF(KDGTYP(KFLCUR,NSET).NE.4) GO TO 8000
      IF(KFLFRM(KFLCUR).EQ.0) THEN
        DO 5010 I=1,NDVPTS
5010    READ(IDFI,END=1) PDVXVL(I),PDVYVL(I),PDVVL1(I)
       ELSE
        DO 5012 I=1,NDVPTS
5012    READ(IDFI,4020,END=1) PDVXVL(I),PDVYVL(I),PDVVL1(I)
      ENDIF
      PDVBEG = PDVXVL(1)
      PDVEND = PDVXVL(NDVPTS)
      GO TO 9000
C *
C *  DATA SET IS OF AN UNKNOW TYPE... READ ONE BYTE ON THE RECORD
C *
8000  IF(KFLFRM(KFLCUR).EQ.0) THEN
        READ(IDFI,END=1) QJUNK
       ELSE
        READ(IDFI,8010,END=1) QJUNK
8010    FORMAT(A1)
      ENDIF
C *
C *  MISSION COMPLETE
9000  RETURN
      END
C ***  GETPAT - GET THE NEXT BUFFER FROM A RAW DATA FILE
C *
      SUBROUTINE GETPAT( NSET, EOFHIT )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      LOGICAL EOFHIT
      DIMENSION XDATA(10)
C *
C *  INITIALIZE FLAGS
1000  EOFHIT = .FALSE.
      NSET   = 1
C *
C *  NUMBER OF RECORDS TO FILL BUFFER
      NUMREC = MNPTS / 10
C *
C *  READ THE DATA FROM THE PATTERN FILE
C *
2000  NDVPTS = 0
      IF(KFLFRM(KFLCUR).EQ.1) THEN
2100    DO 2110 I=1,NUMREC
        READ(IDFI,2120,END=2900) XDATA
2120    FORMAT(10F7.0)
        DO 2130 J=1,10
        NDVPTS = NDVPTS + 1
        PDVYVL(NDVPTS) = XDATA(J) / PTCTIM
2130    CONTINUE
2110    CONTINUE
       ELSE
2200    DO 2210 I=1,NUMREC
        READ(IDFI,END=2900) XDATA
        DO 2220 J=1,10
        NDVPTS = NDVPTS + 1
        PDVYVL(NDVPTS) = XDATA(J) / PTCTIM
2220    CONTINUE
2210    CONTINUE
      ENDIF
      GO TO 3000
C *
C *  THE END OF FILE WAS HIT
2900  EOFHIT = .TRUE.
      IF(NDVPTS.EQ.0) GO TO 9000
C *
C *  CALCULATE STARTING ANGLE OF SEGMENT AND ANGLE FOR NEXT SEGMENT
3000  PDVBEG = PTANXT
      PDVEND = PDVBEG + REAL(NDVPTS-1) * PDGINC(KFLCUR,1)
      PTANXT = PTANXT + REAL(NDVPTS  ) * PDGINC(KFLCUR,1)
C *
C *  SKIP THE DATA SET IF NOT IN PLOTTING RANGE.  FLAG AN EOF HIT IF ENDING
C *  ANGLE IS GREATER THAN THAT OF THE PLOT RANGE
      IF(KAXXRV.EQ.0) THEN
        IF(PDVEND.LT.XAXBEG) NDVPTS = 0
        IF(PDVBEG.GT.XAXEND) NDVPTS = 0
        IF(PDVEND.GE.XAXEND) EOFHIT = .TRUE.
       ELSE
        IF(PDVEND.LT.XAXEND) NDVPTS = 0
        IF(PDVBEG.GT.XAXBEG) NDVPTS = 0
        IF(PDVEND.GE.XAXEND) EOFHIT = .TRUE.
      ENDIF
      IF(NDVPTS.EQ.0) GO TO 9000
C *
C *  ASSIGN ANGULAR VALUES
4000  TEMP = PDVBEG - PDGINC(KFLCUR,1)
      DO 4010 I=1,NDVPTS
      PDVXVL(I) = TEMP + REAL(I) * PDGINC(KFLCUR,1)
      IF(PDVXVL(I).LE.PTEANG) GO TO 4010
      IF(I.EQ.1) THEN
        NDVPTS = 0
        GO TO 9000
       ELSE
        NDVPTS = I - 1
        GO TO 9000
      ENDIF
4010  CONTINUE
C *
9000  RETURN
      END
C ***  GETAXS - GET THE AXIS SYSTEM PARAMETERS
C *
      SUBROUTINE GETAXS( LAXGET )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      LOGICAL LAXGET
      CHARACTER QTNEW*80,QPSIZ(0:2)*12,QNOYS(0:1)*3
      CHARACTER QYMIN*10,QYMAX*10,QOPT(10)*1
      DATA QPSIZ(0) /'8x5 (Screen)'/
      DATA QPSIZ(1) /'........14x8'/
      DATA QPSIZ(2) /'....User set'/
      DATA QNOYS(0) /'.No'/
      DATA QNOYS(1) /'Yes'/
C *
C *  CHECK IF WE ARE HERE JUST TO SET AXIS PARAMETERS...
1000  IF(.NOT.LAXGET) GO TO 2000
C *
C *  ENSURE SCALE FACTOR DEFAULTS TO 1.0
      PPLSCA = 1.0
C *
C **  GET THE AXIS INFORMATION ABOUT THE DESIRED PLOTS.
C *
      WRITE(ITTO,1010)
1010  FORMAT(/,' *   Specification of the axis system attributes:')
C *
C *  USE CURRENT FILE TITLE OR ALLOW THE USER TO SPECIFY ONE
C *
1100  IF(KMODEO.EQ.0) WRITE(ITTO,1110) QPLTID(1:72)
1110  FORMAT(/,1X,A72,/,
     1 '$New plot title? (*=blank) <No change> ')
      READ(ITTI,1120) QTNEW
1120  FORMAT(A80)
      IF(QTNEW.EQ.'*') THEN
        QPLTID = ' '
        IF(KMODEO.EQ.1) WRITE(ITTO,1130)
1130    FORMAT(/,' PLOT TITLE SET TO BLANKS')
       ELSE IF( QTNEW.NE.' ' .AND. QTNEW.NE.'/' ) THEN
        QPLTID = QTNEW
        IF(KMODEO.EQ.1) WRITE(ITTO,1140) QPLTID(1:72)
1140    FORMAT(/,' NEW PLOT TITLE:',/,1X,A72)
       ELSE
        IF(KMODEO.EQ.1) WRITE(ITTO,1150)
1150    FORMAT(/,' PLOT TITLE TAKEN FROM FILE TITLE')
      ENDIF
C *
C *  GET THE ANGULAR RANGE FOR PLOTTING.
C *
C *  ENSURE ANGLES ARE LOW TO HIGH SINCE REVERSE-AXES MAY HAVE BEEN USED
1200  IF(KAXXRV.EQ.0) THEN
        ANGS = XAXBEG
        ANGE = XAXEND
       ELSE
        ANGS = XAXEND
        ANGE = XAXBEG
        XAXBEG = ANGS
        XAXEND = ANGE
        XAXDEL = ABS( XAXDEL )
      ENDIF
C *
C *  GET THE USER SPECIFIED ANGLES AND ENSURE ANGLES ARE LOW-HIGH
      IF(KMODEO.EQ.0) THEN
        WRITE(ITTO,1210) ANGS,ANGE
1210    FORMAT(/,'$X axis range? <',F8.4,',',F8.4,'> ')
        READ(ITTI,*) ANGS,ANGE
       ELSE IF(KMODEO.EQ.1) THEN
        READ(ITTI,1220) ANGS,ANGE
1220    FORMAT(2F6.2)
      ENDIF
      IF(ANGS.GT.ANGE) THEN
        TEMP = ANGS
        ANGS = ANGE
        ANGE = TEMP
      ENDIF
C *
C *  RECORD NEW ANGLES IF THEY HAVE CHANGED.  IF SO THEN RESET ALL KASCFC
C *  SO ALL FILES ARE SEARCHED AGAIN IF AUTOSCALING USED.  RESET DATA-GROUP-
C *  USED FLAGS SO OVERLAPPING SEGMENTS ARE DRAWN PROPERLY
      IF( ANGS.NE.XAXBEG .OR. ANGE.NE.XAXEND ) THEN
        XAXBEG = ANGS
        XAXEND = ANGE
        DO 1222 I=1,KFLTOT
        KASCFC(I) = 0
        DO 1224 J=1,KDGNUM(I)
1224    KDGUSD(I,J) = 0
1222    CONTINUE
      ENDIF
C *
C *  IF IN AUTOMODE THEN VERIFY ANGLES
      IF(KMODEO.EQ.1) WRITE(ITTO,1230) XAXBEG,XAXEND
1230  FORMAT(
     1' USER SPECIFIED PLOTTING RANGE : ',F8.4,' TO ',F8.4,' DEGREES')
C *
C *  GET THE ATTRIBUTES FOR THE AXIS SYSTEM
C *
C *  CONFIRM PARAMETERS
1300  IF(KASCYH.EQ.1) THEN
        QYMAX = 'Auto scale'
       ELSE
        WRITE(QYMAX,'(F10.2)') YAXEND
        IF(QYMAX(1:1).EQ.' ') QYMAX(1:1) = '.'
        IF(QYMAX(2:2).EQ.' ') QYMAX(2:2) = '.'
        IF(QYMAX(3:3).EQ.' ') QYMAX(3:3) = '.'
        IF(QYMAX(4:4).EQ.' ') QYMAX(4:4) = '.'
        IF(QYMAX(5:5).EQ.' ') QYMAX(5:5) = '.'
      ENDIF
      IF(KASCYL.EQ.1) THEN
        QYMIN = 'Auto scale'
       ELSE
        WRITE(QYMIN,'(F10.2)') YAXBEG
        IF(QYMIN(1:1).EQ.' ') QYMIN(1:1) = '.'
        IF(QYMIN(2:2).EQ.' ') QYMIN(2:2) = '.'
        IF(QYMIN(3:3).EQ.' ') QYMIN(3:3) = '.'
        IF(QYMIN(4:4).EQ.' ') QYMIN(4:4) = '.'
        IF(QYMIN(5:5).EQ.' ') QYMIN(5:5) = '.'
      ENDIF
      WRITE(ITTO,1310) KAXBOX,QNOYS(KAXDRW),QPSIZ(KAXSIZ),QNOYS(KAXXRV),
     1  QYMIN,QYMAX,QXAXID(KXAXID),QYAXID(KYAXID)
1310  FORMAT(/,
     1 ' 1  Sections per plot...............',I2,2X,
     1 ' 2  Draw axis system...............',A3,/,
     1 ' 3  Size of plot..........',A12,2X,
     1 ' 4  Reverse X axis numbering.......',A3,/,
     1 ' 5  Min value for Y axis....',A10,2X,
     1 ' 6  Max value for Y axis....',A10,/,
     1 ' 7  ////..... X axis label .......\\\\',2X,
     1 ' 8  ////..... Y axis label .......\\\\',/,
     1 '    ',A26,14X,A26)
      WRITE(ITTO,1320)
1320  FORMAT(/,'$Numbers of options to change? <None> ')
      READ(ITTI,1330) QOPT
1330  FORMAT(10A1)
C *
C *  ALLOW PARAMETERS TO BE CHANGED
1400  DO 1490 I=1,10
      IF(QOPT(I).NE.'1') GO TO 1420
1410  WRITE(ITTO,1412)
1412  FORMAT('$Plot sections? (1/2) <1> ')
      KAXBOX = 1
      READ(ITTI,*,ERR=1300) KAXBOX
      IF( KAXBOX.NE.1 .AND. KAXBOX.NE.2 ) KAXBOX = 1
1420  IF(QOPT(I).NE.'2') GO TO 1430
      WRITE(ITTO,1422)
1422  FORMAT('$Draw the axes? (0/1) <1> ')
      KAXDRW = 1
      READ(ITTI,*,ERR=1300) KAXDRW
      IF( KAXDRW.LT.0 .OR. KAXDRW.GT.1 ) KAXDRW = 1
1430  IF(QOPT(I).NE.'3') GO TO 1440
      WRITE(ITTO,1432)
1432  FORMAT('$Plot size: 0-8x5(Screen), 1-14x8, 2-Set? (0/1/2) <0> ')
      KAXSIZ = 0
      READ(ITTI,*,ERR=1300) KAXSIZ
      IF( KAXSIZ.LT.0 .OR. KAXSIZ.GT.2 ) KAXSIZ = 0
1440  IF(QOPT(I).NE.'4') GO TO 1450
      WRITE(ITTO,1442)
1442  FORMAT('$Reverse X axis numbering? (0/1) <0> ')
      KAXXRV = 0
      READ(ITTI,*,ERR=1300) KAXXRV
      IF( KAXXRV.LT.0 .OR. KAXXRV.GT.1 ) KAXXRV = 0
1450  IF(QOPT(I).NE.'5') GO TO 1460
      WRITE(ITTO,1452)
1452  FORMAT('$Minimum Y axis value? (-99=Auto scale) <0.0> ')
      YAXBEG = 0.0
      READ(ITTI,*,ERR=1300) YAXBEG
      IF(YAXBEG.EQ.-99.0) THEN
        KASCYL = 1
       ELSE
        KASCYL = 0
      ENDIF
1460  IF(QOPT(I).NE.'6') GO TO 1470
      WRITE(ITTO,1462)
1462  FORMAT('$Maximum Y axis value? (-99=Auto scale) <Auto scale> ')
      YAXEND = -99.0
      READ(ITTI,*,ERR=1300) YAXEND
      IF(YAXEND.EQ.-99.0) THEN
        KASCYH = 1
       ELSE
        KASCYH = 0
      ENDIF
1470  IF(QOPT(I).NE.'7') GO TO 1480
      WRITE(ITTO,1472) (J,QXAXID(J),J=1,MXXIDL-1)
1472  FORMAT(' The following axis labels are available:',/,
     1 '   0 - User supplied',/,(3X,I1,' - ',A26))
      WRITE(ITTO,1474) KXAXID
1474  FORMAT(/,'$Choice? <',I1,'> ')
      ITEMP = KXAXID
      READ(ITTI,*,ERR=1300) ITEMP
      IF( ITEMP.LT.0 ) THEN
        GO TO 1470
       ELSE IF( ITEMP.EQ.0 ) THEN
        KXAXID = MXXIDL
        WRITE(ITTO,1476) 'X'
1476    FORMAT(/,'$Enter the new ',A1,'-axis label (26 characters): ')
        READ(ITTI,1477) QXAXID(KXAXID)
1477    FORMAT(A26)
        DO 1478 J=26,1,-1
        IF(QXAXID(KXAXID)(J:J).NE.' ') GO TO 1479
1478    CONTINUE
        J = 1
1479    NXAXID(KXAXID) = -J
       ELSE IF( ITEMP.GT.MXXIDL-1 ) THEN
        GO TO 1470
       ELSE
        KXAXID = ITEMP
      ENDIF
1480  IF(QOPT(I).NE.'8') GO TO 1490
      WRITE(ITTO,1472) (J,QYAXID(J),J=1,MXYIDL-1)
      WRITE(ITTO,1474) KYAXID
      ITEMP = KYAXID
      READ(ITTI,*,ERR=1300) ITEMP
      IF( ITEMP.LT.0 ) THEN
        GO TO 1480
       ELSE IF( ITEMP.EQ.0 ) THEN
        KYAXID = MXYIDL
        WRITE(ITTO,1476) 'Y'
        READ(ITTI,1477) QYAXID(KYAXID)
        QYAXID(KYAXID+10) = QYAXID(KYAXID)
        DO 1482 J=26,1,-1
        IF(QYAXID(KYAXID)(J:J).NE.' ') GO TO 1484
1482    CONTINUE
        J = 1
1484    NYAXID(KYAXID   ) = J
        NYAXID(KYAXID+10) = J
       ELSE IF( ITEMP.GT.MXYIDL-1 ) THEN
        GO TO 1480
       ELSE
        KYAXID = ITEMP
      ENDIF
1490  CONTINUE
C *
C *  REVERSE X AXIS VALES IF REVERSE NUMBERING SPECIFIED
C *
1500  IF(KAXXRV.EQ.1) THEN
        TEMP   = XAXBEG
        XAXBEG = XAXEND
        XAXEND = TEMP
      ENDIF
C *
C **  SET AXES LENGTHS AND ORIGIN ON PAPER
C *
C *  SET SMALL PLOT VALUES
C *
2000  IF(KAXSIZ.NE.0) GO TO 2100
      XAXLEN = 8.0
      YAXLEN = 5.0
      IF(KAXBOX.EQ.2) YAXLEN = 2.0
      YAXOFS = -3.0
      IF(KDEVIC.EQ.0) THEN
        XAXORG = 1.0000
        YAXORG = 0.9000
       ELSE
        XAXORG = 1.3500
        YAXORG = 1.7000
      ENDIF
      IF(KAXBOX.EQ.2) THEN
        IF(KDEVIC.EQ.0) THEN
          YAXORG = 3.9000
         ELSE
          YAXORG = 4.7750
        ENDIF
      ENDIF
      IF(KDEVIC.EQ.0) THEN
CPC        XLBPOS = XAXLEN - 2.40
CPC        YLBPOS = YAXLEN - 0.40
        XLBPOS = XAXLEN - 2.60
        YLBPOS = YAXLEN - 0.55
       ELSE
        XLBPOS = XAXLEN - 2.25
        YLBPOS = YAXLEN - 0.45
      ENDIF
      GO TO 2300
C *
C *  SET LARGE PLOT VALUES, SINGLE OR DOUBLE PER PAGE
C *
2100  IF(KAXSIZ.NE.1) GO TO 2200
      XAXLEN = 14.0
      YAXLEN = 8.0
      IF(KAXBOX.EQ.2) YAXLEN = 4.0
      YAXOFS = -5.0
      XAXORG = 1.0
      YAXORG = 1.4
      IF(KAXBOX.EQ.2) YAXORG = 5.9
      XLBPOS = XAXLEN - 2.5
      YLBPOS = YAXLEN - 0.4
      GO TO 2300
C *
C *  USER WILL SET AXIS PARAMETERS.
C *
C *  IF JUST VERIFYING THEN USE PREVIOUSLY SET VALUES
2200  IF(.NOT.LAXGET) GO TO 2300
C *
      WRITE(ITTO,2210)
2210  FORMAT(/,'$X and Y origin values? <1.35,1.70> ')
      XAXORG = 1.3500
      YAXORG = 1.7000
      READ(ITTI,*) XAXORG,YAXORG
      IF(XAXORG.LT.0.0) XAXORG = 1.3500
      IF(YAXORG.LT.0.0) YAXORG = 1.7000
      XAXLEN = 8.0
      YAXLEN = 5.0
      IF(KAXBOX.EQ.2) YAXLEN = 2.0
      WRITE(ITTO,2220) XAXLEN,YAXLEN
2220  FORMAT(/,
     1'$X and Y axis lengths in integral inches? <',F5.2,',',F5.2,'> ')
      READ(ITTI,*) XAXLEN,YAXLEN
      IF( XAXLEN.LT.1.0 ) XAXLEN = 8.0
      IF( YAXLEN.LT.1.0 .AND. KAXBOX.EQ.1 ) YAXLEN = 5.0
      IF( YAXLEN.LT.1.0 .AND. KAXBOX.EQ.2 ) YAXLEN = 2.0
      IF(KAXBOX.EQ.2) THEN
        YAXOFS = -YAXLEN - 1.0
        WRITE(ITTO,2240) YAXOFS
2240    FORMAT(/,'$Negative offset for the second box? <',F5.2,'> ')
        READ(ITTI,*) YAXOFS
        IF(YAXOFS.GE.0.0) YAXOFS = -YAXLEN - 1.0
      ENDIF
      XLBPOS = 0.30
      YLBPOS = YAXLEN - 0.40
      WRITE(ITTO,2250)
2250  FORMAT('$Scale factor? <1.0> ')
      READ(ITTI,*) PPLSCA
      IF(PPLSCA.LE.0.0) PPLSCA = 1.0
C *
C *  INITIALIZE VALUES FOR YAXEND AND YAXDEL
C *
C *  AUTO SCALE Y AXIS IF REQUESTED
2300  IF( KASCYL.EQ.0 .AND. KASCYH.EQ.0 ) GO TO 2350
      CALL GTMINT
      IF(KASCYL.EQ.1) THEN
        CALL CHKSCA( PASCMN, 3, YAXBEG, TEMP )
      ENDIF
      IF(KASCYH.EQ.1) THEN
        YAXEND = PASCMX
      ENDIF
      IF(YAXBEG.EQ.YAXEND) THEN
        IF(YAXBEG.EQ.0.0) THEN
          YAXEND = 1.0
         ELSE
          YAXBEG = AMIN1( PASCMN, YAXEND-0.1*ABS(YAXEND) )
          CALL CHKSCA( YAXBEG, 3, YAXBEG, TEMP )
        ENDIF
       ELSE IF(YAXBEG.GT.YAXEND) THEN
        YAXBEG = AMIN1( PASCMN, YAXEND-0.1*ABS(YAXEND) )
        CALL CHKSCA( YAXBEG, 3, YAXBEG, TEMP )
      ENDIF
      YAXDEL = (YAXEND-YAXBEG) / YAXLEN
      IF( ABS(YAXEND-YAXBEG).GT.1.0 ) THEN
        NSDG = 2
       ELSE
        NSDG = 2
      ENDIF
      CALL CHKSCA( YAXDEL, NSDG, TEMP, YAXDEL )
      YAXEND = YAXBEG + YAXDEL * YAXLEN
      GO TO 3000
C *
C *  SET UNITS PER INCH FOR Y AXIS AND ADJUST YAXEND TO REFLECT THIS SCALING
2350  IF(YAXBEG.EQ.YAXEND) THEN
        IF(YAXBEG.EQ.0.0) THEN
          YAXEND = 1.0
         ELSE
          YAXBEG = YAXEND - 0.1 * ABS( YAXEND )
        ENDIF
       ELSE IF(YAXBEG.GT.YAXEND) THEN
        TEMP   = YAXBEG
        YAXBEG = YAXEND
        YAXEND = TEMP
      ENDIF
      YAXDEL =  (YAXEND-YAXBEG) / YAXLEN
      IF(YAXDEL.EQ.0.0) YAXDEL = 1.0
      YAXEND = YAXBEG + YAXDEL * YAXLEN
C *
C **  INITIALIZE THE X AXIS VALUES: XAXBEG, XAXEND, XAXDEL
C *
C *  PERFORM CALCULATIONS ONLY IF WERE ARE HERE INITIALIZING PARAMETERS
3000  IF(.NOT.LAXGET) GO TO 9000
C *
C *  FIND BEST XAXDEL VALUE
      XAXDEL = ABS( XAXEND - XAXBEG ) / ( XAXLEN * REAL(KAXBOX) )
      IF(XAXDEL.LE.0.0) XAXDEL = 1.0
      CALL CHKSCA( XAXDEL, 2, TEMP, XAXDEL )
      XAXDEL = SIGN( XAXDEL, (XAXEND-XAXBEG) )
      XAXEND = XAXBEG + XAXLEN * XAXDEL * REAL(KAXBOX)
      IF(KDEVIC.EQ.1) THEN
        WRITE(ITTO,3040) XAXBEG,XAXEND,XAXDEL,XAXLEN,KAXBOX
3040    FORMAT(/,
     1    ' Scan: ',F6.2,' TO ',F6.2,' degrees ',F5.2,' deg/inch',
     1    '  ',F4.0,' inches ',I1,' plots/page')
      ENDIF
C *
C *  EXIT...
9000  RETURN
      END
C ***  GTMINT - DETERMINE MAXIMUM INTENSITY IN ALL DATA SETS
C *
      SUBROUTINE GTMINT
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      LOGICAL FILEOK,EOFHIT
C *
C *  REPEAT FOR EACH FILE NOT PREVIOUSLY CHECKED
C *
1000  DO 1010 KFLCUR=1,KFLTOT
C *
C *  DETERMINE IF FILE NEEDS TO BE CHECKED
      IF(KASCFC(KFLCUR).EQ.1) GO TO 1010
C *
C *  OPEN THE APPROPRIATE FILE AND READ HEADER RECORDS
      IF(KFLTYP(KFLCUR).EQ.0) THEN
        CALL INIPAT( FILEOK, .FALSE., .FALSE. )
      ELSE
        CALL INIPLT( FILEOK, .FALSE., .FALSE. )
      ENDIF
C *
C *  INITIALIZE FILE MIN/MAX VALUES FOR SEARCH
      PASFMN(KFLCUR) = +1.0E30
      PASFMX(KFLCUR) = -1.0E30
C *
C *  READ THE NEXT DATA SET AND PROCEED BASED ON RETURN STATUS
1100  IF(KFLTYP(KFLCUR).EQ.0) THEN
        CALL GETPAT( NSET, EOFHIT )
       ELSE
        CALL GETPLT( NSET, EOFHIT )
      ENDIF
C *
C *  IF NO POINTS AND NOT END OF FILE... TRY NEXT SEGMENT
      IF( NDVPTS.EQ.0 .AND. .NOT.EOFHIT ) GO TO 1100
C *
C *  IF NO POINTS AND END OF FILE... FINISHED
      IF( NDVPTS.EQ.0 .AND.      EOFHIT ) GO TO 1110
C *
C * IF POINT FREQUENCY OR PEN IS 0... SKIP THE SET.
      IF( KDGFRQ(KFLCUR,NSET).EQ.0 .OR.
     1    KDGPEN(KFLCUR,NSET).EQ.0      ) GO TO 1105
C *
C *  FIND THE RANGE FOR THIS DATA SET
      SETMIN = +1.0E30
      SETMAX = -1.0E30
      DO 1120 I=1,NDVPTS
      IF( KAXXRV.EQ.0 .AND.
     1   ( PDVXVL(I).LT.XAXBEG .OR. PDVXVL(I).GT.XAXEND ) ) GO TO 1120
      IF( KAXXRV.EQ.1 .AND.
     1   ( PDVXVL(I).LT.XAXEND .OR. PDVXVL(I).GT.XAXBEG ) ) GO TO 1120
      IF(KDGTYP(KFLCUR,NSET).EQ.3) THEN
        SETMIN = AMIN1( SETMIN, PDVYVL(I)-PDVVL1(I) )
        SETMAX = AMAX1( SETMAX, PDVYVL(I)+PDVVL1(I) )
       ELSE
        SETMIN = AMIN1( SETMIN, PDVYVL(I) )
        SETMAX = AMAX1( SETMAX, PDVYVL(I) )
      ENDIF
1120  CONTINUE
C *
C *  DETERMINE THE SCALING NECESSARY FOR THIS SET OF DATA
      YEFFL  = AMAX1( 1.0, YAXLEN-PDGOFS(KFLCUR,NSET) )
      SETMIN = SETMIN / YEFFL * YAXLEN
      SETMAX = SETMAX / YEFFL * YAXLEN
C *
C *  RECORD LIMITS FOR FILE
      PASFMN(KFLCUR) = AMIN1( PASFMN(KFLCUR), SETMIN )
      PASFMX(KFLCUR) = AMAX1( PASFMX(KFLCUR), SETMAX )
C *
C *  IF NOT END OF FILE... GET NEXT SEGMENT
1105  IF(.NOT.EOFHIT) GO TO 1100
C *
C *  CLOSE THE FILE
1110  CLOSE(UNIT=IDFI)
C *
C *  INDICATE FILE CHECKED
      KASCFC(KFLCUR) = 1
C *
C *  REPEAT FOR NEXT FILE
1010  CONTINUE
C *
C **  FIND MINIMUM AND MAXIMUM
C *
      PASCMN = +1.0E30
      PASCMX = -1.0E30
2000  DO 2010 KFLCUR=1,KFLTOT
      PASCMN = AMIN1( PASCMN, PASFMN(KFLCUR) )
      PASCMX = AMAX1( PASCMX, PASFMX(KFLCUR) )
2010  CONTINUE
C *
C **  TASK COMPLETE
*
9000  RETURN
      END
C ***  CHKSCA - ROUND NUMBER TO NEAREST POWER OF TEN
C *
      SUBROUTINE CHKSCA( VAL, NSD, VDN, VUP )
C *
      IF(ABS(VAL).GT.1.0) THEN
        N = NSD - 1
       ELSE
        N = NSD
      ENDIF
      IF(VAL.NE.0.0) THEN
        FM = 10.0**REAL( INT( ALOG10( ABS(VAL) ) ) - N )
        V1 = AINT( VAL/FM + SIGN(1.0,VAL)*0.99 ) * FM
        V2 = AINT( VAL/FM                      ) * FM
CDBG    WRITE(99,'('' VAL,FM,V1,V2 = '',4F10.5)') VAL,FM,V1,V2
CDBG    WRITE(99,'(''   NSD,N      = '',2I10  )') NSD,N
        IF(VAL.GT.0.0) THEN
          VUP = V1
          VDN = V2
         ELSE
          VUP = V2
          VDN = V1
        ENDIF
       ELSE
         VUP = VAL
         VDN = VAL
      ENDIF
C *
      RETURN
      END
C ***  PLTAXS - PLOT THE AXIS SYSTEM
C *
      SUBROUTINE PLTAXS
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      CHARACTER QYID*60,QXID*60
C *
C **  DRAW THE AXES
C *
C *  IF NO AXIS PLOT IS SELECTED THEN RETURN.
4000  IF(KAXDRW.NE.1) GO TO 9000
C *
C *  SET THE X AND Y AXIS IDS BASED ON KXAXID AND KYAXID
      QXID = QXAXID( KXAXID )
      NXID = NXAXID( KXAXID )
      IF(KAXBOX.EQ.1) THEN
        QYID = QYAXID( KYAXID )
        NYID = NYAXID( KYAXID )
       ELSE
        QYID = QYAXID( KYAXID+10 )
        NYID = NYAXID( KYAXID+10 )
      ENDIF
C *
C *  SET THE TITLE OFFSET FROM TOP OF AXIS
      IF(KDEVIC.EQ.0) THEN
CPC     YIDOFF = 1.50 * VCVSIZ
        YIDOFF = 0.1325
       ELSE
        YIDOFF = 0.1325
      ENDIF
C *
C * PLOT THE FIRST GRAPH BOX ON THE PAPER.
      CALL PEN(1)
      CALL AXIS(0.0,0.0,QYID,NYID,YAXLEN,90.0,YAXBEG,YAXDEL)
      CALL AXIS(0.0,0.0,QXID,NXID,XAXLEN, 0.0,XAXBEG,XAXDEL)
      CALL TICKS(0.,0.,XAXLEN,YAXLEN)
C *
C *  PLOT THE TITLE AFTER BLANK STRIPPING IT
      DO 4010 I=80,1,-1
4010  IF(QPLTID(I:I).NE.' ') GO TO 4020
      I = 1
4020  NCHAR = I
      CALL SYMBOL(0.2,YAXLEN+YIDOFF,0.14,QPLTID,0.0,NCHAR)
C *
C * PLOT THE SECOND GRAPH BOX ON THE PAPER.
      IF(KAXBOX.EQ.1) GO TO 9000
      BPLT1 = XAXBEG + XAXLEN * XAXDEL
      CALL PEN(1)
      CALL AXIS(0.0,YAXOFS,QYID,NYID,YAXLEN,90.0,YAXBEG,YAXDEL)
      CALL AXIS(0.0,YAXOFS,QXID,NXID,XAXLEN, 0.0,BPLT1 ,XAXDEL)
      CALL TICKS(0.0,YAXOFS,XAXLEN,YAXLEN)
C *
C *  EXIT...
9000  RETURN
      END
C ***  PLTLAB - PUT THE DATA GROUP LABELS ON THE PLOT
C *
      SUBROUTINE PLTLAB( NSET, NPOINT, ICODE )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
C *  INITIALIZE THE PLOT FLAG: (0) LABEL NOT DRAWN (1) LABEL DRAWN
      ICODE = 0
C *
C *  IF THE GROUP PLOT CODE OR PEN NUMBER IS ZERO... SKIP THE LABEL
      IF( KDGFRQ(KFLCUR,NSET).EQ.0 .OR. KDGPEN(KFLCUR,NSET).EQ.0 )
     1  GO TO 9000
C *
C *  SKIP LABEL IF FIRST CHARACTER IS A BLANK OR AN ASTERISK (*)
      IF( QDGTTL(KFLCUR,NSET)(1:1).EQ.' ' .OR.
     1    QDGTTL(KFLCUR,NSET)(1:1).EQ.'*'      ) GO TO 9000
C *
C *  DRAW THE DATA GROUP LABEL
      XP = XLBPOS
      IF(KDEVIC.EQ.0) THEN
C-PC
C        CSIZE = VCVSIZ
C        YP = YLBPOS - REAL(NPOINT-1) * (1.05 * CSIZE)
C        XPS = XP - 0.25
C        YPS = YP - 0.05
C-PC
C-TK
        YP = YLBPOS - REAL(NPOINT-1) * 0.16
        CSIZE = 0.100
        XPS = XP - 0.15
        YPS = YP + 0.05
C-TK
       ELSE
        YP = YLBPOS - REAL(NPOINT-1) * 0.16
        CSIZE = 0.100
        XPS = XP - 0.15
        YPS = YP + 0.05
      ENDIF
      CALL PEN( KDGPEN(KFLCUR,NSET) )
      DO 1010 I=20,1,-1
1010  IF(QDGTTL(KFLCUR,NSET)(I:I).NE.' ') GO TO 1020
1020  NCHAR = I
      CALL SYMBOL(XP,YP,CSIZE,QDGTTL(KFLCUR,NSET),0.0,NCHAR)
      ICODE = 1
C *
C *  IF THE DATA GROUP IS DATA POINTS, KEY THE LEGEND
      IF(KDGTYP(KFLCUR,NSET).NE.1) GO TO 9000
      IF(KDGSYM(KFLCUR,NSET).GT.0) THEN
        DELXY = 0.15
        ISYM = KDGSYM(KFLCUR,NSET)
        CALL SMPSYM( XPS, YPS, DELXY, ISYM, 3 )
       ELSE
        DELXY = 0.05
        CALL PLOT( XPS-DELXY, YPS, 3 )
        CALL PLOT( XPS+DELXY, YPS, 2 )
        CALL PLOT( XPS+DELXY, YPS, 3 )
      ENDIF
C *
C *  LABELED....
9000  RETURN
      END
C ***  PLTDAT - PLOT THE 2THETA/I INFORMATION
C *
C *  PROGRAMMER: C.L. MALLORY
C *              ALFRED UNIVERSITY
C *
C *  MODIFIED BY S.A. HOWARD FOR USE IN XRDPLT
C *
      SUBROUTINE PLTDAT( NSET )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      LOGICAL LMOVE, LFIRST, LPOINT, LXYDAT
C *
C * TO PLOT OR NOT TO PLOT THAT IS THE QUESTION.
C * IF POINT FREQUENCY OR PEN IS 0... SKIP THE SET.
1000  IF( KDGFRQ(KFLCUR,NSET).EQ.0 .OR.
     1    KDGPEN(KFLCUR,NSET).EQ.0      ) GO TO 9000
C *
C *  SELECT THE PROPER PEN.
      CALL PEN( KDGPEN(KFLCUR,NSET) )
C *
C *  .LMOVE. MOVE TO POINT WITH PEN UP  .FIRST. FIRST POINT OFFSET AXIS.
C *  .LPOINT. DRAWING POINTS.  INITIALIZE OTHER VARIABLES AS WELL.
      LMOVE  = .TRUE.
      LFIRST = .TRUE.
      LPOINT = KDGFRQ(KFLCUR,NSET).LT.0
      LXYDAT = KDGTYP(KFLCUR,NSET).EQ.1
      IF(LXYDAT) THEN
        DELXY = 0.15
       ELSE
        DELXY = 0.02
      ENDIF
      IFREQ  = IABS( KDGFRQ(KFLCUR,NSET) )
      TTLAST = 0.0
      XPLAST = 0.0
      YPLAST = 0.0
C *
C *  MOVE TO THE LAST PLOTTED DATA POINT FOR THIS DATA GROUP.
      IF( KDGUSD(KFLCUR,NSET).EQ.0 .OR. LPOINT ) GO TO 2000
      IF( ABS(PDVBEG-PDGLXY(KFLCUR,NSET,1))
     1     .LT. 1.5*PDGINC(KFLCUR,NSET)     ) THEN
        CALL PLOT( PDGLXY(KFLCUR,NSET,2), PDGLXY(KFLCUR,NSET,3), 3 )
        LMOVE = .FALSE.
      ENDIF
C *
C **  PLOT THE DATA IN INCREMENTS OF IFREQ.
C *
C *  REPEAT FOR EACH POINT IN THE SET
2000  DO 2010 I=1,NDVPTS,IFREQ
C *
C *  GET THE NEXT DATA POINT
      TT = PDVXVL(I)
      YI = PDVYVL(I)
C *
C *  IF TT IS OUT OF RANGE... DONT PLOT IT
      IF(KAXXRV.EQ.0) THEN
        IF(TT.LT.XAXBEG) GO TO 2010
        IF(TT.GT.XAXEND) GO TO 2040
       ELSE
        IF(TT.LT.XAXEND) GO TO 2010
        IF(TT.GT.XAXBEG) GO TO 2040
      ENDIF
C *
C *  DETERMINE DATA OFFSET AND CORRECT YI FOR IT
      OFFS = PDGOFS(KFLCUR,NSET) * YAXDEL
      YI   = YI + OFFS
C *
C * IF YI IS OUT OF RANGE OF AXES THEN CHOP IT OFF.
      YI = AMIN1( YI, YAXEND )
      YI = AMAX1( YI, YAXBEG )
C *
C *  CONVERT TT AND YI VALUES TO PLOTTER UNITS.
      IF(KAXXRV.EQ.0) THEN
        XP = (TT-XAXBEG) / XAXDEL
       ELSE
        XP = XAXLEN + ( (TT-XAXEND) / XAXDEL )
      ENDIF
      YP = ( YI - YAXBEG ) / YAXDEL
C *
C *  IF THE POINT IS ON THE SECOND AXIS... CORRECT WITH OFFSETS
      IF(KAXXRV.EQ.0) THEN
        IF(XP.LE.XAXLEN) GO TO 2020
        XP = XP - XAXLEN
        YP = YP + YAXOFS
       ELSE
        IF(KAXBOX.EQ.2) YP = YP + YAXOFS
        IF(XP.GE.0.0) GO TO 2020
        XP = XP + XAXLEN
        YP = YP - YAXOFS
      ENDIF
      IF(LFIRST) THEN
        LMOVE = .TRUE.
        LFIRST = .FALSE.
      ENDIF
C *
C *  PERFORM THE MOVE WITH THE PEN UP IF LMOVE FLAG IS SET
2020  IF(LMOVE) THEN
        CALL PLOT( XP, YP, 3 )
        LMOVE = .FALSE.
      ENDIF
C *
C *  MOVE TO POINT WITH PEN DOWN... OR SET PEN DOWN IF ITS UP
      IF(LXYDAT) THEN
        ISYM = KDGSYM(KFLCUR,NSET)
        IF(LPOINT) THEN
          CALL SMPSYM( XP, YP, DELXY, ISYM, 3 )
         ELSE
          CALL SMPSYM( XP, YP, DELXY, ISYM, 2 )
        ENDIF
       ELSE
        IF(LPOINT) THEN
          CALL PLOT( XP, YP, 3 )
          CALL PLOT( XP, YP, 2 )
          CALL PLOT( XP, YP, 3 )
         ELSE
          CALL PLOT(XP,YP,2)
        ENDIF
      ENDIF
C *
C *  RECORD POSITIONS
      TTLAST = TT
      XPLAST = XP
      YPLAST = YP
C *
2010  CONTINUE
C *
C *  PICK THE PEN UP AND RECORD LAST POINT
2040  IF(.NOT.LPOINT) CALL PLOT( XPLAST, YPLAST, 3 )
      PDGLXY(KFLCUR,NSET,1) = TTLAST
      PDGLXY(KFLCUR,NSET,2) = XPLAST
      PDGLXY(KFLCUR,NSET,3) = YPLAST
      KDGUSD(KFLCUR,NSET) = 1
C *
9000  RETURN
      END
C ***  PLTSTK - PLOT THE PEAK LOCATION MARKERS
C *
      SUBROUTINE PLTSTK( NSET )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      CHARACTER QSTKNM*3,QSTKTH*10
C *
C *  ARE WE GOING TO PLOT?
1000  IF( KDGFRQ(KFLCUR,NSET).EQ.0 .OR. KDGPEN(KFLCUR,NSET).EQ.0 )
     1  GO TO 9000
C *
C *  CHARACTER SIZE BASED ON PLOTTING DEVICE AND ANNOTATION TYPE
      IF(KDEVIC.EQ.0) THEN
        CSIZE = 0.255
C-TK
        IF(KSLTYP(KFLCUR).EQ.1) THEN
          CSIZE = 0.10
         ELSE
          CSIZE = 0.08
        ENDIF
C-TK
       ELSE
        IF(KSLTYP(KFLCUR).EQ.1) THEN
          CSIZE = 0.10
         ELSE
          CSIZE = 0.08
        ENDIF
      ENDIF
C *
C *  SELECT THE PROPER PEN.
      CALL PEN( KDGPEN(KFLCUR,NSET) )
C *
C *  PUT THE MARKERS ON FOR ALL LINES
      DO 1010 I=1,NDVPTS
C *
C *  GET THE LOCATION AND HEIGHT OF THE MARKER
      TT = PDVXVL(I)
      IF(PSLSIZ(KFLCUR).EQ.0.0) THEN
        YI = PDVYVL(I)
       ELSE
        YI = PSLSIZ(KFLCUR) * YAXDEL
      ENDIF
C *
C *  IF TT IS OUT OF RANGE OF THE PLOT... DONT PLOT IT.
      IF(KAXXRV.EQ.0) THEN
        IF(TT.LT.XAXBEG) GO TO 1010
        IF(TT.GT.XAXEND) GO TO 1010
       ELSE
        IF(TT.GT.XAXBEG) GO TO 1010
        IF(TT.LT.XAXEND) GO TO 1010
      ENDIF
C *
C *  DETERMINE MARKER OFFSET AND CORRECT MARKER HEIGHT FOR IT
      BASE = PDGOFS(KFLCUR,NSET) * YAXDEL
      YI   = YI + BASE
C *
C *  IF YI OR BASE ARE OUT OR RANGE CHOP THEM OFF
      IF(YI  .GT.YAXEND) YI   = YAXEND
      IF(BASE.GT.YAXEND) BASE = YAXEND
      IF(YI  .LT.YAXBEG) YI   = YAXBEG
      IF(BASE.LT.YAXBEG) BASE = YAXBEG
C *
C *  CONVERT TT, YI AND BASE VALUES TO PLOTTER UNITS.
1030  IF(KAXXRV.EQ.0) THEN
        XP = (TT-XAXBEG) / XAXDEL
       ELSE
        XP = XAXLEN + (TT-XAXEND) / XAXDEL
      ENDIF
      YP   = ( YI     - YAXBEG ) / YAXDEL
      BASE = ( BASE   - YAXBEG ) / YAXDEL
      YMAX = ( YAXEND - YAXBEG ) / YAXDEL
C *
C *  DETERMINE MARKER PLACEMENT BASED ON AXES
      IF(KAXXRV.EQ.0) THEN
        IF(XP.LE.XAXLEN) GO TO 2000
        IF(KAXBOX.EQ.1 ) GO TO 1010
        XP = XP - XAXLEN
        YP = YP + YAXOFS
        BASE = BASE + YAXOFS
        YMAX = YMAX + YAXOFS
       ELSE
        IF(KAXBOX.EQ.2) THEN
          YP   = YP   + YAXOFS
          BASE = BASE + YAXOFS
          YMAX = YMAX + YAXOFS
        ENDIF
        IF(XP.GE.0.0  ) GO TO 2000
        IF(KAXBOX.EQ.1) GO TO 1010
        XP   = XP   + XAXLEN
        YP   = YP   - YAXOFS
        BASE = BASE - YAXOFS
        YMAX = YMAX - YAXOFS
      ENDIF
C *
C *  ANNOTATE MARKER WITH A SERIAL NUMBER
2000  IF(KSLTYP(KFLCUR).NE.1) GO TO 3000
      WRITE(QSTKNM,2010) I
2010  FORMAT(I3)
      NS = 1
      IF(QSTKNM(1:1).EQ.' ') NS = 2
      IF(QSTKNM(2:2).EQ.' ') NS = 3
      NCHAR = 3 - NS + 1
      XMARK = XP + 0.05
      YMARK = YP + 0.10
      YMMAX = YMAX - REAL(NCHAR) * CSIZE
      IF(YMARK.GT.YMMAX) YMARK = YMMAX
      CALL SYMBOL(XMARK,YMARK,CSIZE,QSTKNM(NS:3),0.0,NCHAR)
      GO TO 8000
C *
C *  ANNOTATE THE MARKER WITH THE TWO-THETA VALUE AND RADIATION
3000  IF(KSLTYP(KFLCUR).NE.2) GO TO 4000
      WRITE(QSTKTH,3010) PDVVL1(I),KDVIV1(I)
3010  FORMAT(F8.4,' ',I1)
      NS = 1
      NE = 10
      IF(QSTKTH(1:1).EQ.' ') NS = 2
      IF(QSTKTH(2:2).EQ.' ') NS = 3
      IF(KDVIV1(I).EQ.1) NE = 8
      NCHAR = NE - NS + 1
      XMARK = XP + 0.04
      YMARK = YP + 0.10
      YMMAX = YMAX - REAL(NCHAR) * CSIZE
      IF(YMARK.GT.YMMAX) YMARK = YMMAX
      CALL SYMBOL(XMARK,YMARK,CSIZE,QSTKTH(NS:NE),90.0,NCHAR)
      GO TO 8000
C *
C *  ANNOTATE THE MARKER WITH THE D-SPACING VALUE AND RADIATION
4000  IF(KSLTYP(KFLCUR).NE.3) GO TO 8000
      WRITE(QSTKTH,3010) PDVVL2(I),KDVIV1(I)
      NS = 1
      NE = 10
      IF(QSTKTH(1:1).EQ.' ') NS = 2
      IF(QSTKTH(2:2).EQ.' ') NS = 3
      IF(KDVIV1(I).EQ.1) NE = 8
      NCHAR = NE - NS + 1
      XMARK = XP + 0.04
      YMARK = YP + 0.10
      YMMAX = YMAX - REAL(NCHAR) * CSIZE
      IF(YMARK.GT.YMMAX) YMARK = YMMAX
      CALL SYMBOL(XMARK,YMARK,CSIZE,QSTKTH(NS:NE),90.0,NCHAR)
C *
C *  DRAW THE MARKER
8000  CALL PLOT(XP,BASE,3)
      CALL PLOT(XP,YP  ,2)
C *
1010  CONTINUE
C *
9000  RETURN
      END
C ***  PLVERR - PLOT VERTICAL ERROR BARS
C *
      SUBROUTINE PLVERR( NSET )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      PARAMETER ( DELTAX = 0.05 )
C *
C *  ARE WE GOING TO PLOT?
1000  IF( KDGFRQ(KFLCUR,NSET).EQ.0 .OR. KDGPEN(KFLCUR,NSET).EQ.0 )
     1  GO TO 9000
C *
C *  SELECT THE PROPER PEN.
      CALL PEN( KDGPEN(KFLCUR,NSET) )
C *
C *  REPEAT FOR ALL ERROR BARS
      DO 1010 I=1,NDVPTS
C *
C *  GET THE LOCATION AND HEIGHT OF THE MARKER
      TT   = PDVXVL(I)
      YI   = PDVYVL(I) + PDVVL1(I)
      BASE = PDVYVL(I) - PDVVL1(I)
C *
C *  IF TT IS OUT OF RANGE OF THE PLOT... DONT PLOT IT.
      IF(KAXXRV.EQ.0) THEN
        IF(TT.LT.XAXBEG) GO TO 1010
        IF(TT.GT.XAXEND) GO TO 1010
       ELSE
        IF(TT.GT.XAXBEG) GO TO 1010
        IF(TT.LT.XAXEND) GO TO 1010
      ENDIF
C *
C *  DETERMINE ERROR BAR OFFSET AND CORRECT BARS FOR IT
      OFFS = PDGOFS(KFLCUR,NSET) * YAXDEL
      YI   = YI + OFFS
      BASE = BASE + OFFS
C *
C *  IF YI OR BASE ARE OUT OR RANGE CHOP THEM OFF
      IF(YI  .GT.YAXEND) YI   = YAXEND
      IF(BASE.GT.YAXEND) BASE = YAXEND
      IF(YI  .LT.YAXBEG) YI   = YAXBEG
      IF(BASE.LT.YAXBEG) BASE = YAXBEG
C *
C *  CONVERT TT, YI AND BASE VALUES TO PLOTTER UNITS.
1030  IF(KAXXRV.EQ.0) THEN
        XP = (TT-XAXBEG) / XAXDEL
       ELSE
        XP = XAXLEN + (TT-XAXEND) / XAXDEL
      ENDIF
      YP   = ( YI   -    YAXBEG ) / YAXDEL
      BASE = ( BASE -    YAXBEG ) / YAXDEL
C *
C *  DETERMINE ERROR BAR PLACEMENT BASED ON AXES
      IF(KAXXRV.EQ.0) THEN
        IF(XP.LE.XAXLEN) GO TO 2000
        IF(KAXBOX.EQ.1 ) GO TO 1010
        XP = XP - XAXLEN
        YP = YP + YAXOFS
        BASE = BASE + YAXOFS
       ELSE
        IF(KAXBOX.EQ.2) THEN
          YP   = YP   + YAXOFS
          BASE = BASE + YAXOFS
        ENDIF
        IF(XP.GE.0.0  ) GO TO 2000
        IF(KAXBOX.EQ.1) GO TO 1010
        XP   = XP   + XAXLEN
        YP   = YP   - YAXOFS
        BASE = BASE - YAXOFS
      ENDIF
C *
C *  DRAW THE ERROR BAR
2000  CALL PLOT( XP-DELTAX/2.0, YP  , 3 )
      CALL PLOT( XP+DELTAX/2.0, YP  , 2 )
      CALL PLOT( XP           , YP  , 3 )
      CALL PLOT( XP           , BASE, 2 )
      CALL PLOT( XP-DELTAX/2.0, BASE, 3 )
      CALL PLOT( XP+DELTAX/2.0, BASE, 2 )
C *
1010  CONTINUE
C *
9000  RETURN
      END
C ***  PLHERR - PLOT HORIZONTAL ERROR BARS
C *
      SUBROUTINE PLHERR( NSET )
C *
C *  REFERENCE COMMON BLOCK
      INCLUDE 'XRDPCOM.FOR'
C *
      PARAMETER ( DELTAY = 0.05 )
C *
C *  ARE WE GOING TO PLOT?
1000  IF( KDGFRQ(KFLCUR,NSET).EQ.0 .OR. KDGPEN(KFLCUR,NSET).EQ.0 )
     1  GO TO 9000
C *
C *  SELECT THE PROPER PEN.
      CALL PEN( KDGPEN(KFLCUR,NSET) )
C *
C *  REPEAT FOR ALL ERROR BARS
      DO 1010 I=1,NDVPTS
C *
C *  GET THE LOCATION AND HEIGHT OF THE MARKER
      TT  = PDVXVL(I) - PDVVL1(I)
      TT2 = PDVXVL(I) + PDVVL1(I)
      YI  = PDVYVL(I)
C *
C *  IF TT OR TT2 ARE OUT OF RANGE OF THE PLOT... DONT PLOT IT.
      IF(KAXXRV.EQ.0) THEN
        IF(TT .LT.XAXBEG) GO TO 1010
        IF(TT .GT.XAXEND) GO TO 1010
        IF(TT2.LT.XAXBEG) GO TO 1010
        IF(TT2.GT.XAXEND) GO TO 1010
       ELSE
        IF(TT .GT.XAXBEG) GO TO 1010
        IF(TT .LT.XAXEND) GO TO 1010
        IF(TT2.GT.XAXBEG) GO TO 1010
        IF(TT2.LT.XAXEND) GO TO 1010
      ENDIF
C *
C *  DETERMINE ERROR BAR OFFSET AND CORRECT BARS FOR IT
      OFFS = PDGOFS(KFLCUR,NSET) * YAXDEL
      YI = YI + OFFS
C *
C *  IF YI IS OUT OF RANGE CHOP IT OFF
      IF(YI.GT.YAXEND) YI = YAXEND
      IF(YI.LT.YAXBEG) YI = YAXBEG
C *
C *  CONVERT TT, TT2 AND YI VALUES TO PLOTTER UNITS.
1030  IF(KAXXRV.EQ.0) THEN
        XP  = (TT -XAXBEG) / XAXDEL
        XP2 = (TT2-XAXBEG) / XAXDEL
       ELSE
        XP  = XAXLEN + (TT -XAXEND) / XAXDEL
        XP2 = XAXLEN + (TT2-XAXEND) / XAXDEL
      ENDIF
      YP = (YI- YAXBEG) / YAXDEL
C *
C *  DETERMINE ERROR BAR PLACEMENT BASED ON AXES
      IF(KAXXRV.EQ.0) THEN
        IF(XP .LE.XAXLEN) GO TO 2000
        IF(XP2.LE.XAXLEN) GO TO 2000
        IF(KAXBOX.EQ.1 ) GO TO 1010
        XP  = XP  - XAXLEN
        XP2 = XP2 - XAXLEN
        YP  = YP  + YAXOFS
       ELSE
        IF(KAXBOX.EQ.2) THEN
          YP = YP + YAXOFS
        ENDIF
        IF(XP .GE.0.0 ) GO TO 2000
        IF(XP2.GE.0.0 ) GO TO 2000
        IF(KAXBOX.EQ.1) GO TO 1010
        XP  = XP  + XAXLEN
        XP2 = XP2 + XAXLEN
        YP  = YP  - YAXOFS
      ENDIF
C *
C *  DRAW THE ERROR BAR
2000  CALL PLOT( XP  , YP+DELTAY/2.0, 3 )
      CALL PLOT( XP  , YP-DELTAY/2.0, 2 )
      CALL PLOT( XP  , YP           , 3 )
      CALL PLOT( XP2 , YP           , 2 )
      CALL PLOT( XP2 , YP+DELTAY/2.0, 3 )
      CALL PLOT( XP2 , YP-DELTAY/2.0, 2 )
C *
1010  CONTINUE
C *
9000  RETURN
      END
