C******************** START FILE CONCTR.FOR ; GROUP CONCTR ******************
C============================================================
C  CONCTR    D. MC CUNE MAY 21 1980 -- INTERACTIVE MAIN
C
C  CONTROL GENERATION OF CONTOUR PLOT OF 2D GRID
C  FUNCTION
C
C  PROGRAM USES "UREAD.FOR[GOLD.TRANSP]" AND "UEDIT.FOR[GOLD.TRANSP]"
C
C  USER OPTIONS: GET PLOT
C                CHANGE CONTOUR SELECTION DEFAULTS
C                CHANGE FUNCTION SUBDOMAIN SELECTION DEFAULTS
C                EXIT
C
C  ARGUMENTS:
C    X(NX)    INDEP. VAR ALONG 1ST DIMENSION OF FUNCTION
C    Z(NZ1,NY)  2D FUNCTION TO BE PLOTTED
C    Y(NY)    INDEP VAR. ALONG 2ND DIMENSION OF FUNCTION
C    XLAB     CHAR LABEL FOR X
C    ZLAB     CHAR LABEL FOR Z
C    YLAB     CHAR LABEL FOR Y
C    XUN      CHAR. PHYS. UNITS FOR X TERMINATED WITH "$"
C    ZUN      DITTO FOR Z
C    YUN      DITTO FOR Y
C    RLAB     CHAR. RUN LABEL , E.G. "RUN # 1234"
C             (SHOULDNT BE TERMINATED WITH "$")
C    IINT     FCN INTEGRATION CODE:
C             0 -- NOT INTEGRATED
C             1 -- VOL. INTEGRATED
C             2 -- FLUX. INTEGRATED
C             3 -- AREA INTEGRATED
C    ISMOO    IF ISMOO=1, DATA HAS BEEN SMOOTHED
C                (FOR LABELING)
C    NPAGE  INCREMENTS BY ONE TO YIELD PAGE # OF GRAPH TO BE
C           DRAWN; PAGE # IS ADDL LABEL ON GRAPH
C
      SUBROUTINE CONCTR(X,Z,Y,NX,NZ1,NY,XLAB,ZLAB,YLAB,
     >                    XUN,ZUN,YUN,RLAB,IINT,ISMOO,NPAGE)
C  DECLARATIONS
C   PARAMETER:  MAX # OF CONTOURS
C    LIMITED BY CONTOUR LABELING, SPACE IN KEY
      PARAMETER (NCMAX0=18)
C
C  PASSED ARGS
C
      DIMENSION X(NX),Z(NZ1,NY),Y(NY)
      CHARACTER*(*) XLAB,ZLAB,YLAB,RLAB,XUN,YUN,ZUN
C
C   LOCAL
CX	CHARACTER*128 ZBUFF
C
C  ARRAY OF CONTOUR VALUES
      DIMENSION ZCNTR1(NCMAX0),ZCNTR0(NCMAX0),ZWRK(NCMAX0)
C  CONTOUR ID CHARACTERS
      CHARACTER*1 ACNTR1(NCMAX0)
C
      CHARACTER*3 AONOFF(2)
c
      CHARACTER*10 FLAB,CLAB
c
C  INITIAL DEFAULT FLAG VALUES--
C   SET MIN,MAX CONTOUR LIMITS TO FUNCTION MIN,MAX
C
      LOGICAL NLZMMX,ILZMMX
C   SET  DOMAIN TO ENTIRE DOMAIN OF FUNCTION
      LOGICAL NLXMMX
      LOGICAL NLYMMX
C   SET EQUAL SPACING OF CONTOURS
      LOGICAL NLLOGC
C  SET DEFAULT AXES TYPES TO BE LINEAR
C
C  SET MAX # OF CONTOURS INITIALLY TO PROGRAM LIIMIT
C *LISMAK* 12-APR-88  GENERATED LOGICAL DECLARATIONS
      LOGICAL LCHAR,LXOUT
C *LISMAK* END OF GENERATED LOGICAL DECLARATIONS
C
C => CONCTR               BEGIN DATA BLOCK
C => LISMAK 12-APR-88  MOVED DATA STATEMENTS
      DATA ACNTR1/'A','B','C','D','E','F','G','H','J','K',
     >              'L','M','N','P','Q','R','S','T'/
      DATA AONOFF/'ON ','OFF'/
      DATA FLAB/'FUNCTION  '/
      DATA CLAB/'CONTOUR   '/
      DATA NLZMMX/.TRUE./
      DATA NLXMMX/.TRUE./
      DATA NLYMMX/.TRUE./
      DATA NLLOGC/.FALSE./
      DATA ITYPX0/1/
      DATA ITYPY0/1/
      DATA NCMAX/NCMAX0/
C => END DATA BLOCK
C ====================
C
C  START OF EXECUTABLE CODE-- PRESENT USER OPTIONS
C
C  CHECK FOR MIN. NX, NY
C
      LUNTRM=LNOUT(0)
C
      IF((NX.GT.1).AND.(NY.GT.1)) GO TO 10
        WRITE(LUNTRM,9009) NX,NY
 9009   FORMAT('  NX=',I3,'  NY=',I3/
     >	  '  TOO FEW X OR Y PTS FOR CONTOUR PLOTTING ***')
        CALL UPAUST(1)
        RETURN
C
 10   CONTINUE
      CALL NEUPAG
 11   IF(LXOUT(0)) WRITE(LUNTRM,1001)
 1001 FORMAT(' *CONTOUR PLOTS CONTROLLER* OPTIONS:'/
     >         '  (1) MAKE DEFAULT PLOT'/
     >         '  (2) CHANGE DEFAULTS'/
     >         '  (3) MAKE NON-DEFAULT GRAPH'/
     >         '  (4) EXIT'/)
C
      CALL UREAD(' SUB:CONCTR >> ENTER OPTION #:$')
      if(lchar('Q')) return
C
      IANS=IDCOD(ITERR)
      CALL UCHKOP(IANS,ITERR,1,4,-1,*11)
      IF(IANS.EQ.4) RETURN
C
      IF(IANS.EQ.2) GO TO 200
C
C  MAKE PLOT
C
 100  CONTINUE
C  SET DEFAULTS
C  SET CURRENT MAX # OF CONTOURS
      NCTRY=NCMAX
C
C  SET DOMAIN LIMITS
      IF(NLXMMX) GO TO 140
        XMIN=XMIN0
        XMAX=XMAX0
        GO TO 150
C  TO MIN,MAX OF X
 140  CONTINUE
        XMIN=X(1)
        XMAX=X(NX)
        CALL SPREDM(XMIN,XMAX,XMIN,XMAX)
 150  CONTINUE
C
      IF(NLYMMX) GO TO 160
        YMIN=YMIN0
        YMAX=YMAX0
        GO TO 170
C
 160  CONTINUE
        YMIN=Y(1)
        YMAX=Y(NY)
        CALL SPREDM(YMIN,YMAX,YMIN,YMAX)
 170  CONTINUE
C
C  CONTOUR LIMITS
      IF(NLZMMX) GO TO 110
        CMIN=CMIN0
        CMAX=CMAX0
        IF((CMIN.EQ.0.0).AND.(CMAX.EQ.0.0)) THEN
          DO 109 IC=1,NCTRY
            ZCNTR1(IC)=ZCNTR0(IC)
 109      CONTINUE
        ENDIF
        GO TO 130
 110  CONTINUE
C  SET TO MIN,MAX OF FCN
        IFND=0
        DO 120 IY=1,NY
          IF((Y(IY).LT.YMIN).OR.(Y(IY).GT.YMAX)) GO TO 120
          DO 119 IX=1,NX
            IF((X(IX).LT.XMIN).OR.(X(IX).GT.XMAX)) GO TO 119
            IFND=IFND+1
            IF(IFND.EQ.1) CMIN=Z(IX,IY)
            IF(IFND.EQ.1) CMAX=Z(IX,IY)
            CMIN=AMIN1(CMIN,Z(IX,IY))
            CMAX=AMAX1(CMAX,Z(IX,IY))
 119      CONTINUE
 120    CONTINUE
        CALL SPREDM(CMIN,CMAX,CMIN,CMAX)
C
 130  CONTINUE
C  SET LOG/LIN FLAG
      ILOGC=1
      IF(NLLOGC) ILOGC=2
C  SET AXES TYPES
      ITYPX=ITYPX0
      ITYPY=ITYPY0
C
C  DRAW CONTOURS
C
      ILZMMX=NLZMMX
      IF(IANS.EQ.3) GO TO 300
C
C-------------------------
C  THE PLOT ITSELF...
C
 180  CONTINUE
      CALL CONPLT(X,Z,Y,NX,NZ1,NY,XLAB,ZLAB,YLAB,
     >       XUN,ZUN,YUN,RLAB,IINT,ISMOO,ITYPX,ITYPY,
     >       XMIN,XMAX,CMIN,CMAX,YMIN,YMAX,NCTRY,ILOGC,NLZMMX,
     >       ZCNTR1,ACNTR1,NPAGE)
C
      NLZMMX=ILZMMX
      GO TO 10
C
C-------------------------
C
C  CHANGE DEFAULTS
C
 200  CONTINUE
C
      CALL NEUPAG
C
C  DISPLAY CURRENT SETTINGS
      WRITE(LUNTRM,2001) XLAB,YLAB,ZLAB
 2001 FORMAT(/
     >' X = ',A/
     >' Y = ',A/
     >' dependent data = ',A/)
      IVAL=ILVAL(NLZMMX)
      IF(LXOUT(0)) CALL UDISP1(0,1,AONOFF(IVAL),'NO ',
     >     'SET CONTOUR LIMITS TO DEPENDENT DATA MIN,MAX$')
C
      IVAL=ILVAL(NLXMMX)
      IF(LXOUT(0)) CALL UDISP1(1,2,AONOFF(IVAL),'NO ',
     >     'SET X AXIS LIMITS TO DATA MIN,MAX$')
C
      IVAL=ILVAL(NLYMMX)
      IF(LXOUT(0)) CALL UDISP1(1,3,AONOFF(IVAL),'NO ',
     >     'SET Y AXIS LIMITS TO DATA MIN,MAX$')
C
      IVAL=ILVAL(NLLOGC)
      IF(LXOUT(0)) CALL UDISP1(1,4,AONOFF(IVAL),'NO ',
     >   'SET LOGARITHMIC SPACING FOR CONTOURS$')
C
C  GET USER RESPONSE
      IF(LXOUT(0)) WRITE(LUNTRM,2002)
 2002 FORMAT(/' ENTER SWITCH # TO TOGGLE SWITCH VALUE;'/
     >          ' OR "G" TO GO ON')
      CALL UREAD(' SUB:CONCTR >> CHANGE DEFAULT:$')
C
      IF(LCHAR('G')) GO TO 250
      if(lchar('Q')) goto 10
C
      ISW=IDCOD(ITERR)
      CALL UCHKOP(ISW,ITERR,1,4,1,*200)
      GO TO (210,220,230,240) ISW
C
C  CONTOUR MIN/MAX SWITCH
 210  CONTINUE
        NLZMMX=.NOT.NLZMMX
        GO TO 200
C XMIN,XMAX SWITCH
 220  CONTINUE
        NLXMMX=.NOT.NLXMMX
        GO TO 200
C  YMIN,YMAX SWITCH
 230  CONTINUE
        NLYMMX=.NOT.NLYMMX
        GO TO 200
C  LOG.LIN FLAG
 240  CONTINUE
        NLLOGC=.NOT.NLLOGC
        GO TO 200
C
C   END OF DEFAULTS SECTION:  GET NEW MAX # OF CONTOURS
C    AND OTHER VALUES TO BE SET BY USER
C
 250  CONTINUE
      CALL NEUPAG
      IF(LXOUT(0)) WRITE(LUNTRM,2501)
 2501 FORMAT(/' ENTER "X" NOT TO CHANGE THE VALUE OF A PARAMETER'/
     >	        ' ENTER "L" TO ENTER LIST OF CONTOUR TEST VALUES'/
     >          '    INSTEAD OF MIN/MAX LIMITS CMIN,CMAX'/)
      IERT=0
      IF(NLZMMX) GO TO 260
 251    CALL UREAD(' SUB:CONCTR >> ENTER NEW DEFAULT CMIN:$')
        IERT=0
        IF(LCHAR('Q')) GOTO 250
        IF(LCHAR('L')) GOTO 255
        ZMIN0=CMIN0
        IF(.NOT.LCHAR('X')) ZMIN0=FDCOD(IERT)
        IF(IERT.NE.0) GO TO 251
 252    CALL UREAD(' SUB:CONCTR >> ENTER NEW DEFAULT CMAX:$')
        IERT=0
        IF(LCHAR('Q')) GOTO 250
        IF(LCHAR('L')) GOTO 255
        ZMAX0=CMAX0
        IF(.NOT.LCHAR('X')) ZMAX0=FDCOD(IERT)
        IF(IERT.NE.0) GO TO 252
C
        CALL SPREDM(ZMIN0,ZMAX0,CMIN0,CMAX0)
        ZDC=CMAX0-CMIN0
        CMAX0=CMAX0+.0001*ZDC
        CMIN0=CMIN0-.0001*ZDC
        GO TO 260
C
 255    CONTINUE
C  GET A SORTED LIST OF CONTOUR TEST VALUES
        CMIN0=0.0
        CMAX0=0.0
        IRET=0
        CALL INORD(ZCNTR0,ZWRK,NCMAX0,IRET,
     >      'DEFAULT CONTOUR TEST VALUES',0)
        IF(IRET.EQ.0) GOTO 250
        NCMAX=IRET
C
 260  CONTINUE
      IF(NLXMMX) GO TO 270
 261    CALL UREAD(' SUB:CONCTR >> ENTER NEW DEFAULT XMIN:$')
        IERT=0
        IF(LCHAR('Q')) GOTO 280
        ZMIN0=XMIN0
        IF(.NOT.LCHAR('X')) ZMIN0=FDCOD(IERT)
        IF(IERT.NE.0) GO TO 261
 262    CALL UREAD(' SUB:CONCTR >> ENTER NEW DEFAULT XMAX:$')
        IERT=0
        IF(LCHAR('Q')) GOTO 280
        ZMAX0=XMAX0
        IF(.NOT.LCHAR('X')) ZMAX0=FDCOD(IERT)
        IF(IERT.NE.0) GO TO 262
C
        CALL SPREDM(ZMIN0,ZMAX0,XMIN0,XMAX0)
C
 270  CONTINUE
      IF(NLYMMX) GO TO 280
 271    CALL UREAD(' SUB:CONCTR >> ENTER NEW DEFAULT YMIN:$')
        IERT=0
        IF(LCHAR('Q')) GOTO 280
        ZMIN0=YMIN0
        IF(.NOT.LCHAR('X')) ZMIN0=FDCOD(IERT)
        IF(IERT.NE.0) GO TO 271
 272    CALL UREAD(' SUB:CONCTR >> ENTER NEW DEFAULT YMAX:$')
        IERT=0
        IF(LCHAR('Q')) GOTO 280
        ZMAX0=YMAX0
        IF(.NOT.LCHAR('X')) ZMAX0=FDCOD(IERT)
        IF(IERT.NE.0) GO TO 272
C
        CALL SPREDM(ZMIN0,ZMAX0,YMIN0,YMAX0)
C
 280  CONTINUE
      IF((CMIN0.NE.0.0).OR.(CMAX0.NE.0.0)) THEN
        ILMIN=2
        ILMAX=NCMAX0
        IF(LXOUT(0)) WRITE(LUNTRM,2020) ILMIN,ILMAX,NCMAX
 2020   FORMAT(/' PROGRAM''S MIN # OF CONTOURS = ',I3/
     >		  ' PROGRAM''S MAX # OF CONTOURS = ',I3/
     >		  ' CURRENT    MAX # OF CONTOURS = ',I3)
 281    CALL UREAD(
     >	  ' SUB:CONCTR >> ENTER MAX # OF CONTOURS YOU WANT TO SEE:$')
        ICMAX=NCMAX
        if(lchar('Q')) GOTO 10
        IERT=0
        IF(.NOT.LCHAR('X')) ICMAX=IDCOD(IERT)
        IF(IERT.NE.0) GO TO 281
        IF((ICMAX.LT.ILMIN).OR.(ICMAX.GT.ILMAX)) GO TO 280
        NCMAX=ICMAX
      ENDIF
C
C  AXES TYPES
 282  CONTINUE
      CALL NEUPAG
      IF(LXOUT(0)) WRITE(LUNTRM,2025) ITYPX0,ITYPY0
 2025 FORMAT(/' AXES TYPE CODES: 1-- LINEAR, 2-- LOG'/
     >  ' CURRENT DEFAULT SETTINGS:  X AXIS:  ',I1/
     >  '                            Y AXIS:  ',I1/)
 283  CALL UREAD(
     >  ' SUB:CONCTR >> ENTER NEW DEFAULT X AXIS TYPE:$')
      IF(LCHAR('X')) GO TO 284
      if(lchar('Q')) GOTO 10
      IANS=IDCOD(IERT)
      IF(IERT.NE.0) GO TO 283
      IF((IANS.LE.0).OR.(IANS.GT.2)) GO TO 282
      ITYPX0=IANS
 284  CALL UREAD(
     >  ' SUB:CONCTR >> ENTER NEW DEFAULT Y AXIS TYPE:$')
      IF(LCHAR('X')) GO TO 289
      if(lchar('Q')) GOTO 10
      IANS=IDCOD(IERT)
      IF(IERT.NE.0) GO TO 284
      IF((IANS.LE.0).OR.(IANS.GT.2)) GO TO 284
      ITYPY0=IANS
 289  CONTINUE
C
      GO TO 10
C
C  MAKE NON-DEFAULT PLOT:  GET ALL CONTROLS EXPLICITLY FROM USER
C
 300  CONTINUE
      CALL CONRDF(X,Z,Y,NX,NZ1,NY,ITYPX,ITYPY,
     >              XLAB,XUN,YLAB,YUN,ZUN,NLZMMX,
     >     XMIN,XMAX,CMIN,CMAX,YMIN,YMAX,NCTRY,ILOGC,
     >     ZCNTR1,ZWRK,NCMAX0)
      GO TO 180
      END
C******************** END FILE CONCTR.FOR ; GROUP CONCTR ******************
