      SUBROUTINE PLOTPC(XMIN,XMAX,YMIN,YMAX,XPLO,YPLO,XMPLO,YMPLO,
     +     NPLO,NMPLO,IMARK,NCURVE,NDCL1,NDCL2,NDCL3,
     +     TEXT,SPNAME,IFLAG,XAMI,XAMA,YAMI,YAMA)
C
      IMPLICIT INTEGER*2 (A-Z)
C     IMPLICIT INTEGER (A-Z)
C
      REAL*4 XMIN,XMAX,YMIN,YMAX,XPLO,YPLO,XMPLO,YMPLO
      REAL*4 TEXT,SPNAME
      REAL*4 X,Y,XT,YT,XH,YH,IY,IX
      REAL*4 LEGY(8),LEGX1(8),LEGX2(8),LEGX3(8)
      REAL*4 XAMI,XAMA,YAMI,YAMA,YTT,XTT,XTTDEL,YTTDEL
      REAL*4 XX,YY
      REAL*4 FXTR,FYTR,XMAXSCR,YMAXSCR
C
      INTEGER*4 NPLO,NMPLO,IMARK,NCURVE,NDCL1,NDCL2,NDCL3,IFLAG
      INTEGER*4 LCOL,MCOL,TCOL,NAUX,TWO,MTYP,LTYP
      INTEGER*4 IGKS,XTICKS,YTICKS
      REAL*4 RGKS
C
      CHARACTER*4  CXAX,CYAX
      CHARACTER*6  CLOG
      CHARACTER*8  C8
      CHARACTER*9  C9
      CHARACTER*12 CNAME
      CHARACTER*32 CTEXT
C
c  Description of Integer Common Workspace:
c
c  Name: Common / cigks / igks
c
c  Position      meaning                     value 
c
c
c   1  workstation type (for screen)         set elsewhere 
c   2  connection identifier                 icon=1         
c   3  workstation identifier                iwk=1         
c
c   4  workstation type (for first other wk) set elsewhere
c   5  connection identifier                 icon=2         
c   6  workstation identifier                iwk=2         
c
c   7  workstation type (for first other wk) set elsewhere
c   8  connection identifier                 icon=3         
c   9  workstation identifier                iwk=3         
c
c                                          value     
c
c  10  color index for background            0   1   
c  11                  forground (white)     1   0  
c  12                  red                   2   0
c  13                  yellow                3   0
c  14                  green                 4   0
c  15                  cyan                  5   0
c  16                  blue                  6   0   
c  17                  magenta               7   0 
c  18
c  19
c
c                                          value 
c  20
c  21  aspect source flag no. 1              1
c  22                                        1
c  .
c  .
c  .
c  33  aspect source flag no. 13             1
c
c  49  logical unit for GKS error messages   lgerr=49   
c 
c
      common / cigks / igks(100)
      common / crgks / rgks(100)
c
      DIMENSION XX(500),YY(500),ECHOXY(2)
      DIMENSION LCOL(8),MCOL(8),TCOL(8),MTYP(8),LTYP(8)
C
      DIMENSION NPLO(NDCL1)
      DIMENSION XPLO(NDCL2,NDCL1),YPLO(NDCL2,NDCL1)
      DIMENSION XMPLO(NDCL3,NDCL1),YMPLO(NDCL3,NDCL1)
      DIMENSION TEXT(8),SPNAME(3,NDCL1),IFLAG(10)
      DIMENSION CNAME(8)
C
      DATA ECHOXY /0, 0 /
C     DATA LCOL /2,3,4,5,6,7,1,1/
      DATA LCOL /1,1,1,1,1,1,1,1/
C     DATA MCOL /2,3,4,5,6,7,1,1/
      DATA MCOL /1,1,1,1,1,1,1,1/
C     DATA TCOL /2,3,4,5,6,7,1,1/
      DATA TCOL /1,1,1,1,1,1,1,1/
C     DATA MTYP /2,3,4,5,6,2,3,4/
      DATA MTYP /2,3,4,5,1,2,3,4/
      DATA LTYP /1,2,3,4,1,2,3,4/
      DATA LEGY /.1, .15, .2, .25, .1, .15, .2, .25/
      DATA LEGX1 /0.0, 0.0, 0.0, 0.0, 0.4, 0.4, 0.4, 0.4/
      DATA LEGX2 /0.1, 0.1, 0.1, 0.1, 0.5, 0.5, 0.5, 0.5/
      DATA LEGX3 /0.12, 0.12, 0.12, 0.12, 0.52, 0.52, 0.52, 0.52/
C
      FXTR(X)=0.19*XMAXSCR+XMAXSCR/(XMAX-XMIN)*(X-XMIN)*0.75
C
      FYTR(Y)=0.2*YMAXSCR+YMAXSCR/(YMAX-YMIN)*(Y-YMIN)*0.70
C
      TWO=2
      XTICKS=5
      YTICKS=5
      CXAX='TIME'
      CYAX='CONC'
      CLOG='LOG OF'
C
      IF (IFLAG(3).EQ.1) THEN
      CXAX=CYAX
      ENDIF
C
      IF (IFLAG(3).NE.0) CXAX=CYAX
C
C***
C*** WORKSTATION IS OPENED
C***
C
      call glark0 ('lplot.init')
c     clrect (0.,0.,1.,1.,1,0)
C
      XMAXSCR=.95
      YMAXSCR=.72
C
C***
C*** THE NET IS DRAWN
C***
C
C     DO 41 XT=XMIN,XMIN+(XMAX-XMIN)*1.01,(XMAX-XMIN)/(2*XTICKS)
C       XX(1)=FXTR(XT)
C       YY(1)=FYTR(YMIN)
C       XX(2)=XX(1)
C       YY(2)=FYTR(YMAX)
C  41 CONTINUE
C
C     DO 51 YT=YMIN,YMIN+(YMAX-YMIN)*1.01,(YMAX-YMIN)/(2*YTICKS)
C       XX(1)=FXTR(XMIN)
C       YY(1)=FYTR(YT)
C       XX(2)=FXTR(XMAX)
C       YY(2)=YY(1)
C  51 CONTINUE
C
C***
C*** BORDER LINE FOR THE WHOLE SCREEN IS DRAWN
C***
C
C   set polyline colour index
      CALL GSPLCI(IGKS(15))
      XX(1)=0
      YY(1)=0
      XX(2)=XMAXSCR
      YY(2)=YY(1)
      XX(3)=XX(2)
      YY(3)=YMAXSCR
      XX(4)=XX(1)
      YY(4)=YY(3)
      XX(5)=XX(1)
      YY(5)=YY(1)
C   polyline
      CALL GPL(5,XX,YY)
      XX(2)=4500
      XX(3)=XX(2)
      YY(3)=2000
      YY(4)=YY(3)
C   set fill area colour index
      CALL GSFACI(IGKS(10))
C   set fill area interior style
      CALL GSFAIS(1)
C   fill area
      CALL GFA(5,XX,YY)
C   polyline
      CALL GPL(5,XX,YY)
C
C***
C*** BORDER LINE FOR THE PLOT IS DRAWN
C***
C
      XX(1)=FXTR(XMIN)
      YY(1)=FYTR(YMIN)
      XX(2)=FXTR(XMAX)
      YY(2)=YY(1)
      XX(3)=XX(2)
      YY(3)=FYTR(YMAX)
      XX(4)=XX(1)
      YY(4)=YY(3)
      XX(5)=XX(1)
      YY(5)=YY(1)
C   set polyline colour index
      CALL GSPLCI(IGKS(15))
C   polyline
      CALL GPL(5,XX,YY)
C
C***
C*** THE TITLE IS WRITTEN
C***
C
C   set text colour index
      call gstxci(igks(11))
      DO 80 I=1,8
         I1=1+(I-1)*4
         I2=I1+3
         WRITE(CTEXT(I1:I2),999) TEXT(I)
 80   CONTINUE
C   set text alignment
      call gstxal(3,4)
C     XH=XMIN-(XMAX-XMIN)*0.03
      XH=XMIN
      XH=XMIN+(XMAX-XMIN)*0.05
      YH=YMAX+(YMAX-YMIN)*0.05
C   text
      call gtx(fxtr(xh),fytr(yh),ctext)
C
C***
C*** THE TICKS AND THE NUMBERS FOR THE X-AXIS
C***
C
      XTT=XAMI
      XTTDEL=(XAMA-XAMI)/XTICKS
C   set character spacing
      call gschsp(0.9)
C   set character height
      call gschh(0.0008)
      DO 40 XT=XMIN,XMIN+(XMAX-XMIN)*1.01,(XMAX-XMIN)/XTICKS
         WRITE(C9,998) XTT
         XTT=XTT+XTTDEL
         XX(1)=FXTR(XT)
         YY(1)=FYTR(YMIN)
         XX(2)=XX(1)
         YH=YMIN+(YMAX-YMIN)*0.02
         YY(2)=FYTR(YH)
C   polyline
         CALL GPL(TWO,XX,YY)
C   set text alignment
         call gstxal(2,3)
        YH=YMIN-(YMAX-YMIN)*0.025
C   text
        call gtx(xx(1),fytr(yh),c9)
 40   CONTINUE
C
C***
C*** THE TICKS AND THE NUMBERS FOR THE Y-AXIS
C***
C
      YTT=YAMI
      YTTDEL=(YAMA-YAMI)/YTICKS
      DO 50 YT=YMIN,YMIN+(YMAX-YMIN)*1.01,(YMAX-YMIN)/YTICKS
         XX(1)=FXTR(XMIN)
         WRITE(C9,998) YTT
         YTT=YTT+YTTDEL
         YY(1)=FYTR(YT)
         XH=XMIN+(XMAX-XMIN)*0.015
         XX(2)=FXTR(XH)
         YY(2)=YY(1)
C   polyline
         CALL GPL(TWO,XX,YY)
C   set text alignment
         call gstxal(2,5)
         XH=XMIN-(XMAX-XMIN)*0.016
C   text
         call gtx(fytr(xh),yy(1),c9)
 50   CONTINUE
C   set character spacing
      call gschsp(1.0)
C   set character height
      call gschh(0.01)
C
C***
C*** THE TEXT ON THE X-AXIS
C***
C
C   set text alignment
      call gstxal(3,4)
      YH=YMIN-(YMAX-YMIN)*0.13
C   text
      call gtx(fxtr(xmax),fytr(yh),cxax)
      IF (IFLAG(1).EQ.1) THEN
         IX=FXTR(XMAX)-3700
C   text
         call gtx(ix,fytr(yh),clog)
      ENDIF
C
C***
C*** THE TEXT ON THE Y-AXIS
C***
C
C   set text alignment
      call gstxal(2,4)
      XH=XMIN-(XMAX-XMIN)*0.19
      IY=FYTR(YMAX)
C   text
      call gtx(fxtr(xh),iy,cyax)
      IF (IFLAG(2).EQ.1) THEN
C   text
         call gtx(fxtr(xh),fytr(ymax),clog)
      ENDIF
C
C
C***
C*** THE CURVES AND THE MARKS ON THE CURVES ARE DRAWN
C*** AND THE LEGEND IS WRITTEN
C***
C
      DO 30 J=1,NCURVE
         DO 20 I=1,NPLO(J)
            XX(I)=FXTR(XPLO(I,J))
            YY(I)=  FYTR(YPLO(I,J))
 20      CONTINUE
C
C   set polyline colour index
         call gsplci(igks(10+j))
c   set linetyp
         call gsln(ltyp(j))
         NAUX=NPLO(J)
C   polyline
         call gpl(naux,xx,yy)
         IF (IMARK.NE.0) THEN
            DO 60 I=1,NMPLO
               XX(I)=FXTR(XMPLO(I,J))
               YY(I)=  FYTR(YMPLO(I,J))
 60         CONTINUE
C   set polymarker colour index
            call gspmci(mcol(j))
C   set marker type
            call gsmk(mtyp(j))
            NAUX=NMPLO
C   polyline
            call gpl(naux,xx,yy)
         ENDIF
         IF (IFLAG(3).EQ.0) THEN
            DO 90 I=1,3
            I1=1+(I-1)*4
            I2=I1+3
            WRITE(CNAME(J)(I1:I2),999) SPNAME(I,J)
 90      CONTINUE
         XX(1)=FXTR(XMIN+(XMAX-XMIN)*LEGX1(J))
         YY(1)=FYTR(YMIN-(YMAX-YMIN)*LEGY(J))
         XX(2)=FXTR(XMIN+(XMAX-XMIN)*LEGX2(J))
         YY(2)=YY(1)
C   set polyline colour index
         call gsplci(igks(10+j))
C   polyline
         call gpl(two,xx,yy)
C   set polymarker colour index
         call gspmci(mcol(j))
C   set marker type
         call gsmk(mtyp(j))
         if (imark.ne.0) call gpm(two,xx,yy)
         VI=TCOL(J)
         XH=XMIN+(XMAX-XMIN)*LEGX3(J)
C   set text alignment
         call gstxal(1,4)
C   text
         call gtx(fxtr(xh),yy(1),cname(j))
      ELSE
         DO 110 I=1,3
            I1=1+(I-1)*4
            I2=I1+3
            WRITE(CNAME(J)(I1:I2),999) SPNAME(I,J)
            WRITE(CNAME(J+1)(I1:I2),999) SPNAME(I,J+1)
 110     CONTINUE
         XX(1)=FXTR(XMIN+(XMAX-XMIN)*0.0 )
         YY(1)=FYTR(YMIN-(YMAX-YMIN)*0.175)
         XX(2)=FXTR(XMIN+(XMAX-XMIN)*0.1 )
         YY(2)=YY(1)
C   set polyline colour index
         call gsplci(igks(10+j))
C   polyline
         call gpl(two,xx,yy)
C   set polymarker colour index
         call gspmci(mcol(j))
C   set marker type
         call gsmk(mtyp(j))
         if (imark.ne.0) call gpl(two,xx,yy)
         VI=TCOL(J)
         XH=XMIN+(XMAX-XMIN)*0.12
         YY(1)=FYTR(YMIN-(YMAX-YMIN)*0.15)
C   text
         call gtx(fxtr(xh),yy(1),cname(1))
         YY(1)=FYTR(YMIN-(YMAX-YMIN)*0.20)
C   text
         call gtx(fxtr(xh),yy(1),cname(2))
         C8='(x-Axis)'
         XH=XMIN+(XMAX-XMIN)*0.50
         YY(1)=FYTR(YMIN-(YMAX-YMIN)*0.15)
C   text
         call gtx(fxtr(xh),yy(1),c8)
         C8='(y-Axis)'
         YY(1)=FYTR(YMIN-(YMAX-YMIN)*0.20)
C   text
        call gtx(fxtr(xh),yy(1),c8)
        ENDIF
  30  CONTINUE
C
C
C***
C*** WAITING FOR A CR AND CLOSING OF THE WORK STATION
C***
C
      call gksdc0(1)
C
 997  FORMAT(I2,A1,I2,A1,I2)
 998  FORMAT(1PE9.2)
 999  FORMAT(A4)
C
      RETURN
      END
      SUBROUTINE PLOMAGR (NX,NY,XLEN,YLEN,H,XP,YP,INDEX,NDIM,ICASE,LOUT,
     1     TEXT,IFLAG)
C
      IMPLICIT INTEGER (V)
C
      REAL TEXT(8),XP(*),YP(*),H
      INTEGER*2 INDEX(*)
CI4        INTEGER INDEX(*)
      INTEGER IFLAG(10)
C
      REAL      FXTR,FYTR,XX,YY
C     INTEGER*2 HOROUT,VERTOUT,IRAD
C     INTEGER*2 ECHOXY,NOMINATE
      INTEGER ECHOXY,NOMINATE
      CHARACTER*3 C3
      CHARACTER*32 CTEXT
C
c  Description of Integer Common Workspace:
c
c  Name: Common / cigks / igks
c
c  Position      meaning                     value 
c
c
c   1  workstation type (for screen)         set elsewhere 
c   2  connection identifier                 icon=1         
c   3  workstation identifier                iwk=1         
c
c   4  workstation type (for first other wk) set elsewhere
c   5  connection identifier                 icon=2         
c   6  workstation identifier                iwk=2         
c
c   7  workstation type (for first other wk) set elsewhere
c   8  connection identifier                 icon=3         
c   9  workstation identifier                iwk=3         
c
c                                          value     
c
c  10  color index for background            0      
c  11                  forground (white)     1     
c  12                  red                   2    
c  13                  yellow                3   
c  14                  green                 4  
c  15                  cyan                  5 
c  16                  blue                  6      
c  17                  magenta               7     
c  18
c  19
c
c                                          value 
c  20
c  21  aspect source flag no. 1              1
c  22                                        1
c  .
c  .
c  .
c  33  aspect source flag no. 13             1
c
c  49  logical unit for GKS error messages   lgerr=49   
c 
c
      common / cigks / igks(100)
      common / crgks / rgks(100)
c
      DIMENSION ECHOXY(2),NOMINATE(19),XX(10),YY(10)
      DATA NOMINATE /1, 1, 1, 3, 1, 1, 1, 0, 0, 1, 1, 68,
     +     73, 83, 80, 76, 65, 89, 32/
      DATA ECHOXY /0, 0 /
C
      FXTR(X)=0.03*XMAXSCR+XMAXSCR/XMAX*X*0.88
      FYTR(Y)=0.02*YMAXSCR+YMAXSCR/YMAX*Y*0.80
C
C      FXTR(X)=0.19*XMAXSCR+XMAXSCR/(XMAX-XMIN)*(X-XMIN)*0.75
C      FYTR(Y)=0.2*YMAXSCR+YMAXSCR/(YMAX-YMIN)*(Y-YMIN)*0.70
C
      call glark0 ('glarkm.init')
C
      XMAX=20.0
      YMAX=10.0
      HMIN=0.005
      YDIST=.3
      YTEXT=.3
      YLEG=.3
      XLEG=1.0
      XDIST=.25
      YTXTH=0.
      YTITH=0.
      YLEGH=0.
      XLEGH=0.
C
      IF(IFLAG(1).EQ.1) YTXTH=YTEXT+YDIST
      IF(IFLAG(2).EQ.1) YTITH=YTEXT+YDIST
      IF(IFLAG(3).EQ.1) YLEGH=YLEG+YDIST
      IF(IFLAG(3).EQ.1) XLEGH=XLEG+XDIST
C
      YMAX=YMAX-YTXTH-YTITH-YLEGH
      XMAX=XMAX-XLEGH
 10   CONTINUE
      open (unit=33, file='GRAOUT')
C
      IF(H.LT.HMIN) GOTO 1000
      IF(XLEN.LE.XMAX.AND.YLEN.LT.YMAX) GOTO 100
      RED1=XMAX/XLEN
      RED2=YMAX/YLEN
      RED=AMIN1(RED1,RED2)
      WRITE(LOUT,9000) RED
      IF(RED*H.LT.HMIN) GOTO 1000
      H=RED*H
      XLEN=RED*XLEN
      YLEN=RED*YLEN
      DO 50 I=1,NDIM
         XP(I)=RED*XP(I)
         YP(I)=RED*YP(I)
 50   CONTINUE
 100  CONTINUE
C
C***
C*** CLEAR WINDOW
C***
      call clrect (0.,0.,1.,1.,0,1)
C
C***
C*** OPEN WORK FILE
C***
C
      XMAXSCR=2.0
      YMAXSCR=1.0
C
      XPH=0.
      YPH=YLEN+YLEGH+YTITH+YDIST
      HT=YTEXT
      IF (IFLAG(1).EQ.1) THEN
C***
C*** THE TITLE IS WRITTEN
C***
C
         DO 83 I=1,8
            I1=1+(I-1)*4
            I2=I1+3
            WRITE(CTEXT(I1:I2),9920) TEXT(I)
 83      CONTINUE
         call gtx(fxtr(xph),fytr(yph),ctext)
C
      ENDIF
C
      XPH=0.
      YPH=YLEN+YLEGH+YDIST
      write(6,*) "iflag=",IFLAG(2),"    icase=",ICASE
C
      IF (IFLAG(2).EQ.1.AND.ICASE.EQ.0) THEN
         call gtx(fxtr(xph),fytr(yph),
     1        'Pattern of the Jacobian')
      ENDIF
C
C
      IF (IFLAG(2).EQ.1.AND.ICASE.EQ.1) THEN
         call gtx(fxtr(xph),fytr(yph),
     1        'Stoichiometric Pattern')
      ENDIF
C
      HT=YTEXT
      XPH=XLEGH+H
      YPH=YLEN+YDIST
      HT=YLEG
      HT=YLEG
      XPH=XLEGH+XLEN/2.0-3.*HT
      IF(ICASE.EQ.1) XPH=XPH-HT
      YPH=YLEN+YDIST
      HT=YLEG
      IF (IFLAG(3).EQ.1.AND.ICASE.EQ.0) THEN
         call gtx(fxtr(xph),fytr(yph),
     1        'NSP')
      ENDIF
      IF (IFLAG(3).EQ.1.AND.ICASE.EQ.1) THEN
         call gtx(fxtr(xph),fytr(yph),
     1        'NCEQ')
      ENDIF
      XPH=XLEGH+XLEN-3.*HT
      WRITE(C3,9930) NY
      IF (IFLAG(3).EQ.1) THEN
         call gtx(fxtr(xph),fytr(yph),C3)
         XPH=XLEGH+1.0*HT
         call gtx(fxtr(xph),fytr(yph),'1')
      ENDIF
      HT=YLEG
      XPH=0.
      YPH=YLEN-HT
      IF (IFLAG(3).EQ.1) THEN
         call gtx(fxtr(xph),fytr(yph),
     1        '  1')
      ENDIF
      XPH=0.
      YPH=0.
      IF (IFLAG(3).EQ.1) THEN
         WRITE(C3,9930) NX
         call gtx(fxtr(xph),fytr(yph),C3)
      ENDIF
      XPH=0.
      YPH=0.+YLEN/2.0
      IF (IFLAG(3).EQ.1) THEN
         call gtx(fxtr(xph),fytr(yph),
     1        'NSP')
      ENDIF
      XPH=XLEGH
      YPH=0.
C
C     STATUS=VSFINT(DEVHANDLE,1)
C     K1=0
C     DO 70 I=1,NY,10
C       K1=K1+1
C       K2=0
C       DO 72 J=1,NX,10
C         K2=K2+1
C         K=MOD(K1+K2,2)
C         XUA=XPH+XLEN/(NY+1)*(I-0.5)
C         YUA=YPH+YLEN-YLEN/(NX+1)*(J-0.5)
C         XUE=XPH+XLEN/(NY+1)*(-0.5+ MIN(NY+1,I+10))
C         YUE=YPH+YLEN-YLEN/(NX+1)*(-0.5+ MIN(NX+1,J+10))
C         XX(1)=FXTR(XUA)
C         YY(1)=FYTR(YUA)
C         XX(2)=FXTR(XUE)
C         YY(2)=FYTR(YUA)
C         XX(3)=FXTR(XUE)
C       YY(3)=FYTR(YUE)
C         XX(4)=FXTR(XUA)
C       YY(4)=FYTR(YUE)
C         XX(5)=FXTR(XUA)
C       YY(5)=FYTR(YUA)
C
C         IF (K.GT.0) THEN
C         call gsfaci(igks(10))
C         ENDIF
C         IF (K.EQ.0) THEN
C           call gsfaci(igks(10))
C         ENDIF
C         VI=5
C         call gfa(VI,XX,YY)
C72     CONTINUE
C70   CONTINUE
C
C
C***
C*** BORDER LINE FOR THE PLOT IS DRAWN
C***
C
      XX(1)=FXTR(XPH)
      YY(1)=FYTR(YPH)
      XX(2)=FXTR(XPH+XLEN)
      YY(2)=FYTR(YPH)
      XX(3)=FXTR(XPH+XLEN)
      YY(3)=FYTR(YLEN)
      XX(4)=FXTR(XPH)
      YY(4)=FYTR(YLEN)
      XX(5)=FXTR(XPH)
      YY(5)=FYTR(YPH)
C
      call gsplci(igks(11))
      VI=5
      call gpl(VI,XX,YY)
C
C     IRAD=(FXTR(H)-FXTR(H/2))
      DO 200 I=1,NDIM
        XPH=XP(I)+XLEGH
        YPH=YP(I)
      call gsplci(igks(11))
C     STATUS=VSFINT(DEVHANDLE,1)
C
      VI=3
      IF (INDEX(I).EQ.0) THEN
          VI=3
C       STATUS=VSFCOL(DEVHANDLE,VI)
      ENDIF
      IF (INDEX(I).EQ.1) THEN
          VI=2
C       STATUS=VSFCOL(DEVHANDLE,VI)
      ENDIF
      IF (INDEX(I).EQ.2) THEN
          VI=4
C       STATUS=VSFCOL(DEVHANDLE,VI)
      ENDIF
C
      call gpm(1,FXTR(XPH),FYTR(YPH))
 200  CONTINUE
C
      call gksdc0(1)
C
      RETURN
 1000 CONTINUE
      WRITE(LOUT,9010)
C
      call gksdc0(1)
C
      RETURN
 9000 FORMAT(/,50H  Plot Hardware not able to create desired picture,/,
     1     35H  Restart with a total reduction of,F5.2)
 9010 FORMAT(/,43H  Plot Hardware not able to resolve picture,/)
 9920 FORMAT(A4)
 9930 FORMAT(I3)
      END
      subroutine clrect (x1,y1,x2,y2,icint,icout)
c
      dimension x(5),y(5)
c
c
      npts=5            
      x(1)=x1
      y(1)=y1 
      x(2)=x2 
      y(2)=y(1)
      x(3)=x(2)
      y(3)=y2  
      x(4)=x(1)
      y(4)=y(3)
      x(5)=x(1)
      y(5)=y(1)
c 
c  Set Fill Area Internal Style: 0=leer,1=voll,2=Muster,3=Schraffur
c
      call gsfaci (icint)
      call gsfais (0)
      call gfa (npts,x,y)
      call gsfaci (icout)
      call gsfais (1)
      call gfa (npts,x,y)
c
      return
      end
      subroutine gkscl0  
c                                                                      =
c=======================================================================
c                                                                      =
c  close gks                                                           =
c                                                                      =
c=======================================================================
c                                                                      =
c                                                                      =
c=======================================================================
c                                                                      =
c  Date of latest change: $Date: 1995/08/21 15:38:58 $
c                                                                      =
c=======================================================================
c                                                                      =
c  
      common / cigks / igks(100)
      common / crgks / rgks(100)
c
c
      call gclks
c
      lugkse=igks(49)
      if (lugkse .ne. 6) close (unit=lugkse)
c
c
      return 
c
c=======================================================================
c  end subroutine gkscl0
c=======================================================================
c
      end
      subroutine gksdc0 (icount)
c                                                                      =
c=======================================================================
c                                                                      =
c  desactivate/close a worksation                                      =
c                                                                      =
c=======================================================================
c                                                                      =
c                                                                      =
c=======================================================================
c                                                                      =
c  Date of latest change: August 29, '89                               =
c                                                                      =
c=======================================================================
c                                                                      =
c  
      common / cigks / igks(100)
      common / crgks / rgks(100)
c
c
      ih1=3*(icount-1)+1
      iwt=igks(ih1)
      iwk=igks(ih1+2)
c
      if(iwt.eq.0) return
c
      call gdawk (iwk)
      call gclwk (iwk)
c
c
      return 
c
c=======================================================================
c  end subroutine gksdc0
c=======================================================================
c
      end
      subroutine gksoa0 (iwtype,icount)
c                                                                      =
c=======================================================================
c                                                                      =
c  open and activate a workstation                                     =
c                                                                      =
c=======================================================================
c                                                                      =
c                                                                      =
c=======================================================================
c                                                                      =
c  Date of latest change: August 29, '89                               =
c                                                                      =
c=======================================================================
c 
c
c  Description of Integer Common Workspace:
c
c  Name: Common / cigks / igks
c
c  Position      meaning                     value 
c
c
c   1  workstation type (for screen)         set elsewhere 
c   2  connection identifier                 icon=1         
c   3  workstation identifier                iwk=1         
c
c   4  workstation type (for first other wk) set elsewhere
c   5  connection identifier                 icon=2         
c   6  workstation identifier                iwk=2         
c
c   7  workstation type (for first other wk) set elsewhere
c   8  connection identifier                 icon=3         
c   9  workstation identifier                iwk=3         
c
c                                          value     
c
c  10  color index for background            0      0
c  11                  forground (white)     1      1
c  12                  red                   2      1
c  13                  yellow                3      1
c  14                  green                 4      1
c  15                  cyan                  5      1
c  16                  blue                  6      1
c  17                  magenta               7      1
c  18
c  19
c
c                                          value 
c  20
c  21  aspect source flag no. 1              1
c  22                                        1
c  .
c  .
c  .
c  33  aspect source flag no. 13             1
c
c  49  logical unit for GKS error messages   lgerr=49   
c
c  
c
      dimension red(8),green(8),blue(8)
c
c
      common / cigks / igks(100)
      common / crgks / rgks(100)
c
c
      data red  /0. , 1. , 1. , 1. , 0. , 0. , 0. , 1. /
      data green/0. , 1. , 0. , 1. , 1. , 1. , 0. , 0. /
      data blue /0. , 1. , 0. , 0. , 0. , 1. , 1. , 1. /
c
c
c  set identifier
c
      igks(2)=1
      igks(3)=1
      igks(5)=2
      igks(6)=2
      igks(8)=3
      igks(9)=3
c
      ih1=3*(icount-1)+1
      igks(ih1)=iwtype
      icon=igks(ih1+1)
      iwk=igks(ih1+2)
c
      if(iwtype.eq.0) return
c
c
c  open and activate workstation
c-------------------------------
c
      call gopwk (iwk,icon,iwtype)
      call gacwk (iwk)  
      call gsds (iwk,0,0)  
c
c  define color table
c--------------------
c
      if(iwtype.eq.3100.or.iwtype.eq.3101.or.iwtype.eq.3110) then
c
c  color workstation (background plus 7 colors):
c
         write(6,*) 'setting color table'
         do 10 i=0,7
            ih=i+1
            call gscr (iwk,i,red(ih),green(ih),blue(ih))
 10      continue
c
c  set pointers to color table
c
         do 20 i=0,7
            igks(10+i)=i
 20      continue
c
      else 
c
c  monchome workstation (background plus foreground):
c
         call gscr (iwk,0,0.,0.,0.)
         call gscr (iwk,1,1.,1.,1.)
c
c        write(6,*) 'setting color table to 0 and 1'
         igks(10)=0
         do 30 i=1,7
            igks(10+i)=1
 30      continue
c
      endif
c
      return
c
c=======================================================================
c  end subroutine gksoa0
c=======================================================================
c
      end
      subroutine gksop0 
c                                                                      =
c=======================================================================
c                                                                      =
c  open and init gks                                                   =
c                                                                      =
c=======================================================================
c                                                                      =
c                                                                      =
c=======================================================================
c                                                                      =
c  Date of latest change: August 29, '89                               =
c  $Id: lputil.f,v 1.2 1995/08/21 15:38:58 poehle Exp $
c                                                                      =
c=======================================================================
c 
c
c  Description of Integer Common Workspace:
c
c  Name: Common / cigks / igks
c
c  Position      meaning                     value 
c
c
c   1  workstation type (for screen)         set elsewhere 
c   2  connection identifier                 icon=1         
c   3  workstation identifier                iwk=1         
c
c   4  workstation type (for first other wk) set elsewhere
c   5  connection identifier                 icon=2         
c   6  workstation identifier                iwk=2         
c
c   7  workstation type (for first other wk) set elsewhere
c   8  connection identifier                 icon=3         
c   9  workstation identifier                iwk=3         
c
c                                          value     
c
c  10  color index for background            0        
c  11                  forground (white)     1         
c  12                  red                   2      
c  13                  yellow                3     
c  14                  green                 4    
c  15                  cyan                  5   
c  16                  blue                  6  
c  17                  magenta               7 
c  18
c  19
c
c                                          value 
c  20
c  21  aspect source flag no. 1              1
c  22                                        1
c  .
c  .
c  .
c  33  aspect source flag no. 13             1
c
c  49  logical unit for GKS error messages   lugkse=49   
c
c  
      common / cigks / igks(100)
      common / crgks / rgks(100)
c
c   
      do 1 i=1,100
         igks(i)=0
         rgks(i)=0.
 1    continue
c
c  Logical unit for GKS error output
      lugkse=49
      igks(49)=lugkse
      open (unit=lugkse,file='GKS-ERRORS')
c     rewind lugkse
c
c  open gks 
c
      call gopks (lugkse, -1)
c
c  set aspect source flags to individual
c
      do 10 i=21,33
 10   igks(i)=1
c
      call gsasf (igks(21))
c
      return
c
c=======================================================================
c  end subroutine gksop0
c=======================================================================
c
      end
      subroutine glark0 (graini)
c                                                                      =
c=======================================================================
c                                                                      =
c  open and init gks for graphic menue                                 =
c                                                                      =
c=======================================================================
c                                                                      =
c                                                                      =
c=======================================================================
c                                                                      =
c  Date of latest change: August 29, '89                               =
c                                                                      =
c=======================================================================
c 
c
c  Description of Integer Common Workspace:
c
c  Name: Common / cigks / igks
c
c  Position      meaning                     value 
c
c
c   1  workstation type (for screen)         set elsewhere 
c   2  connection identifier                 icon=1         
c   3  workstation identifier                iwk=1         
c
c   4  workstation type (for first other wk) set elsewhere
c   5  connection identifier                 icon=2         
c   6  workstation identifier                iwk=2         
c
c   7  workstation type (for first other wk) set elsewhere
c   8  connection identifier                 icon=3         
c   9  workstation identifier                iwk=3         
c
c                                          value         nscol2
c
c  10  color index for background            0              0
c  11                  forground (white)     1              1
c  12                  red                   2              1
c  13                  yellow                3              1
c  14                  green                 4              0
c  15                  cyan                  5              0
c  16                  blue                  6              0
c  17                  magenta               7              0        
c  18
c  19
c
c                                          value 
c  20
c  21  aspect source flag no. 1              1
c  22                                        1
c  .
c  .
c  .
c  33  aspect source flag no. 13             1
c
c  49  logical unit for GKS error messages   lgerr=49   
c
c  
c
      character*(*) graini
c
c
      double precision rcom
      integer icom
      character*1 ccom
c
      common / pdexcr / rcom(1500)
      common / pdexci / icom(1500)
      common / pdexcc / ccom(1500)
c
c
      common / cigks / igks(100)
      common / crgks / rgks(100)
c
c     write(6,*) ' graini=',graini 
c
c  Logical unit for screen window init
      lugpi=46
      open (unit=lugpi,file=graini)
      rewind lugpi   
c
c     call gksop0
      icom(901)=1
c
c  read workstation type for screen workstation
      read(lugpi,*) iwtype
c     write(6,*) ' iwtype=',iwtype
c
      call gksoa0 (iwtype,1)
      icom(901)=1
c
      if(iwtype.eq.0) close (unit=lugpi)
      if(iwtype.eq.0) return
c
      iwk=igks(3)
c
c  read positions of gks-window in screen
      read(lugpi,*) x1,x2
      read(lugpi,*) y1,y2
c     write(6,*) ' position on screen:'
c     write(6,*) x1,x2
c     write(6,*) y1,y2
c
c  save positions
      rgks(1)=x1
      rgks(2)=x2
      rgks(3)=y1
      rgks(4)=y2
      call gswkvp (iwk,x1,x2,y1,y2)
      xyh=(y2-y1)/(x2-x1)
      if(xyh.le.1.) then
c
c  assume this case for all pdex1m graphic programs
         rgks(5)=xyh
         call gswkwn (iwk,0.0,1.0,0.0,xyh)
CT         write(6,*) ' assumed case occured'
      else
         xyh=1./xyh
         call gswkwn (iwk,0.0,xyh,0.0,1.)
      endif
c
      close (unit=lugpi)
      icom(901)=3
c
      return
c
c=======================================================================
c  end subroutine gpdex0
c=======================================================================
c
      end
      subroutine zlogo2 (lunit)
      real x(500),y(500)
      dimension red(8),green(8),blue(8)
      character*1 char
c
      common / cigks / igks(100)
      common / crgks / rgks(100)
c  
      common / trafo / scscx(10),scscy(10),xsxs(10),ysys(10),itrafo
c 
c
      data red  /0. , 1. , 1. , 1. , 0. , 0. , 0. , 1. /
      data green/0. , 1. , 0. , 1. , 1. , 1. , 0. , 0. /
      data blue /0. , 1. , 0. , 0. , 0. , 1. , 1. , 1. /
c
c
      iwk=igks(3)
      if(iwk.eq.0) return
c
      do 10 i=0,7
         ih=i+1
         jh=i+100
c        call gscr (iwk,jh,red(ih),green(ih),blue(ih))
10    continue 
      x(1)=0.1
      y(1)=0.1
      x(2)=0.9
      y(2)=0.9
      call gpl (2,x,y)
c     return
c 
      open (unit=lunit,file='zlogo.data')
      rewind lunit
c
      read(lunit,9001) char
      read(lunit,9001) char
      read(lunit,9001) char
      read(lunit,9001) char
      read(lunit,9001) char
9000  format(2e16.6)
9001  format(a1)
c 
      call gclrwk(iwk,1)
c 
      ih=-1
1     continue
      ih=ih+1
c 
c 
      read(lunit,*,end=2000,err=2000) npts
      read(lunit,9000) (x(l),y(l),l=1,npts)
c 
c     icol=mod(ih,7)+101
      icol=1
      call gsplci (icol)
      call gpl (npts,x,y)
c 
c 
      goto 1
c 
c 
2000  continue
c 
      close (unit=lunit)
c 
c
      return
c 
c---------------------------------------------------------------------
c  end of subroutine zlogo2
c---------------------------------------------------------------------
c 
      end
