C
      SUBROUTINE CASE41(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER VEK4(4)
      INTEGER IRC,VRC,VPF
      PARAMETER (IRC=5,VRC=6,VPF=14)
C
      DOUBLE PRECISION FVAL
      INTEGER S1
      INTEGER IVAL
C
      INTEGER REAL
      PARAMETER (REAL=277)
C
        S1=YYV(YYPVT-3)
        IF (SYMTYP(S1) .NE. 0) THEN
          IERR=4
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMTYP(S1)=REAL
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(0,FVAL,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
        VEK4(1)=0
        VEK4(2)=0
        VEK4(3)=0
        VEK4(4)=IWA(6)
        CALL PUT4(VEK4,IRC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMREF(S1)=IWA(5)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE42(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER VEK4(4)
      INTEGER IHELP1,IHELP2,IHELP3,IHELP4,GETIWA
      INTEGER IIS,VIS,IRC,VRC,VPF,IV
      PARAMETER (IIS=1,VIS=2,IRC=5,VRC=6,VPF=14,IV=15)
C
      DOUBLE PRECISION FVAL
      INTEGER S1,S3,S8,S10
      INTEGER IVAL,I
C
      INTEGER INDEX,REAL,INDVAR
      PARAMETER (INDEX=276,REAL=277,INDVAR=291)
C
        S1=YYV(YYPVT-10)
        S3=YYV(YYPVT-8)
        S8=YYV(YYPVT-3)
        S10=YYV(YYPVT-1)
        IF (SYMTYP(S1) .NE. 0) THEN
          IERR=4
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMTYP(S1)=REAL
        SYMREF(S1)=IWA(5)+1
        IF (SYMTYP(S3) .EQ. 0) THEN
          SYMTYP(S3)=INDVAR
          CALL PUT1(0,0.0D0,IV,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
          IF (IERR .NE. 0) THEN
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
          SYMREF(S3)=IWA(15)
        ELSE IF (SYMTYP(S3) .NE. INDVAR) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IF (SYMTYP(S10) .NE. INDEX) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIS,SYMREF(S10),3,IWA,LIWA,INFOLI)
        IF ((S3 .NE. S8) .OR. (IHELP1 .LE. 0)) THEN
          IERR=33
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        VEK4(1)=1
        VEK4(2)=GETIWA(IIS,SYMREF(S10),4,IWA,LIWA,INFOLI)
        VEK4(3)=0
        VEK4(4)=IWA(6)+1
        CALL PUT4(VEK4,IRC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IRC,IWA(5),2,IWA,LIWA,INFOLI)
        DO 1300 I=1,IHELP1
          CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
 1300   CONTINUE
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIS,SYMREF(S10),2,IWA,LIWA,INFOLI)
        DO 1310 I=1,IHELP1
          IHELP2=GETIWA(IIS,SYMREF(S10),5,IWA,LIWA,INFOLI)
          IHELP3=GETIWA(VIS,IHELP2+I-1,0,IWA,LIWA,INFOLI)
          CALL PUT1(IHELP3,0.0D0,IV,SYMREF(S3),LIWA,PLIWA,IWA,LWA,PLWA,
     1              WA,INFOLI,IERR)
          CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
          IF (IERR .NE. 0) THEN
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
          IHELP1=GETIWA(IRC,IWA(5),2,IWA,LIWA,INFOLI)
          IHELP4=GETIWA(IV,SYMREF(S3),0,IWA,LIWA,INFOLI)
          CALL PUT1(0,FVAL,VRC,IWA(6)-IHELP1+IHELP4,LIWA,PLIWA,IWA,LWA,
     1              PLWA,WA,INFOLI,IERR)
 1310   CONTINUE
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE43(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER IHELP1,IHELP2,GETIWA
      INTEGER VIC,IRC,VRC,VPF
      PARAMETER (VIC=4,IRC=5,VRC=6,VPF=14)
C
      DOUBLE PRECISION FVAL
      INTEGER S1,S3
      INTEGER IVAL
C
      INTEGER REAL
      PARAMETER (REAL=277)
C
        S1=YYV(YYPVT-6)
        S3=YYV(YYPVT-4)
        IF (SYMTYP(S1) .NE. REAL) THEN
          IERR=7
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(VIC,S3,0,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IRC,SYMREF(S1),2,IWA,LIWA,INFOLI)
        IF ((IHELP1 .LT. 1) .OR. 
     1      (IHELP1 .GT. IHELP2)) THEN
          IERR=33
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IRC,SYMREF(S1),4,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(VIC,S3,0,IWA,LIWA,INFOLI)
        CALL PUT1(0,FVAL,VRC,IHELP1+IHELP2-1,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1      INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE44(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER VEK4(4)
      INTEGER IHELP1,IHELP2,IHELP3,IHELP4,IHELP5,IHELP6,IHELP7
      INTEGER IHELP8,IHELP9,GETIWA
      INTEGER IIS,VIS,IRC,VRC,VPF,IV
      PARAMETER (IIS=1,VIS=2,IRC=5,VRC=6,VPF=14,IV=15)
C
      DOUBLE PRECISION FVAL
      INTEGER S1,S3,S5,S10,S12,S14,S16
      INTEGER IVAL,I,J
C
      INTEGER INDEX,REAL,INDVAR
      PARAMETER (INDEX=276,REAL=277,INDVAR=291)
C
        S1=YYV(YYPVT-16)
        S3=YYV(YYPVT-14)
        S5=YYV(YYPVT-12)
        S10=YYV(YYPVT-7)
        S12=YYV(YYPVT-5)
        S14=YYV(YYPVT-3)
        S16=YYV(YYPVT-1)
        IF (SYMTYP(S1) .NE. 0) THEN
          IERR=4
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMTYP(S1)=REAL
        SYMREF(S1)=IWA(5)+1
        IF (SYMTYP(S3) .EQ. 0) THEN
          SYMTYP(S3)=INDVAR
          CALL PUT1(0,0.0D0,IV,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
          IF (IERR .NE. 0) THEN
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
          SYMREF(S3)=IWA(15)
        ELSE IF (SYMTYP(S3) .NE. INDVAR) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IF (SYMTYP(S5) .EQ. 0) THEN
          SYMTYP(S5)=INDVAR
          CALL PUT1(0,0.0D0,IV,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
          IF (IERR .NE. 0) THEN
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
          SYMREF(S5)=IWA(15)
        ELSE IF (SYMTYP(S5) .NE. INDVAR) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IF ((SYMTYP(S12) .NE. INDEX) .OR. 
     1      (SYMTYP(S16) .NE. INDEX)) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIS,SYMREF(S12),3,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IIS,SYMREF(S16),3,IWA,LIWA,INFOLI)
        IF ((S3 .NE. S10) .OR. (S5 .NE. S14) .OR. 
     1      (IHELP1 .LE. 0) .OR. (IHELP2 .LE. 0)) THEN
          IERR=33
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        VEK4(1)=2
        VEK4(2)=GETIWA(IIS,SYMREF(S12),4,IWA,LIWA,INFOLI)
        VEK4(3)=GETIWA(IIS,SYMREF(S16),4,IWA,LIWA,INFOLI)
        VEK4(4)=IWA(6)+1
        CALL PUT4(VEK4,IRC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IRC,IWA(5),2,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IRC,IWA(5),3,IWA,LIWA,INFOLI)
        DO 1400 I=1,IHELP1*IHELP2
          CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
 1400   CONTINUE
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIS,SYMREF(S12),2,IWA,LIWA,INFOLI)
        DO 1420 I=1,IHELP1
          IHELP2=GETIWA(IIS,SYMREF(S12),5,IWA,LIWA,INFOLI)
          IHELP3=GETIWA(VIS,IHELP2+I-1,0,IWA,LIWA,INFOLI)
          CALL PUT1(IHELP3,0.0D0,IV,SYMREF(S3),LIWA,PLIWA,IWA,LWA,PLWA,
     1              WA,INFOLI,IERR)
          IHELP4=GETIWA(IIS,SYMREF(S16),2,IWA,LIWA,INFOLI)
          DO 1410 J=1,IHELP4
            IHELP5=GETIWA(IIS,SYMREF(S16),5,IWA,LIWA,INFOLI)
            IHELP6=GETIWA(VIS,IHELP5+J-1,0,IWA,LIWA,INFOLI)
            CALL PUT1(IHELP6,0.0D0,IV,SYMREF(S5),LIWA,PLIWA,IWA,LWA,
     1                PLWA,WA,INFOLI,IERR)
            CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
            IF (IERR .NE. 0) THEN
              LNUM=LNUM-1
              GO TO 9999
            ENDIF
          IHELP1=GETIWA(IRC,IWA(5),2,IWA,LIWA,INFOLI)
          IHELP2=GETIWA(IRC,IWA(5),3,IWA,LIWA,INFOLI)
          IHELP7=GETIWA(IV,SYMREF(S3),0,IWA,LIWA,INFOLI)
          IHELP8=GETIWA(IRC,IWA(5),3,IWA,LIWA,INFOLI)
          IHELP9=GETIWA(IV,SYMREF(S5),0,IWA,LIWA,INFOLI)
          CALL PUT1(0,FVAL,VRC,
     1              IWA(6)-(IHELP1*IHELP2)+(IHELP7-1)*IHELP8+IHELP9,
     2              LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
 1410     CONTINUE
 1420   CONTINUE
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE45(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER IHELP1,IHELP2,IHELP3,IHELP4,GETIWA
      INTEGER VIC,IRC,VRC,VPF
      PARAMETER (VIC=4,IRC=5,VRC=6,VPF=14)
C
      DOUBLE PRECISION FVAL
      INTEGER S1,S3,S5
      INTEGER IVAL
C
      INTEGER REAL
      PARAMETER (REAL=277)
C
        S1=YYV(YYPVT-8)
        S3=YYV(YYPVT-6)
        S5=YYV(YYPVT-4)
        IF (SYMTYP(S1) .NE. REAL) THEN
          IERR=7
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(VIC,S3,0,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(VIC,S5,0,IWA,LIWA,INFOLI)
        IHELP3=GETIWA(IRC,SYMREF(S1),2,IWA,LIWA,INFOLI)
        IHELP4=GETIWA(IRC,SYMREF(S1),3,IWA,LIWA,INFOLI)
        IF ((IHELP1 .LT. 1) .OR. (IHELP1 .GT. IHELP3) .OR.
     1      (IHELP2 .LT. 1) .OR. (IHELP2 .GT. IHELP4)) THEN
          IERR=33
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IRC,SYMREF(S1),4,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(VIC,S3,0,IWA,LIWA,INFOLI)
        IHELP3=GETIWA(IRC,SYMREF(S1),3,IWA,LIWA,INFOLI)
        IHELP4=GETIWA(VIC,S5,0,IWA,LIWA,INFOLI)
        CALL PUT1(0,FVAL,VRC,IHELP1+(IHELP2-1)*IHELP3+IHELP4-1,
     1            LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE49(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER VEK4(4)
      INTEGER IIC,VIC,VPF
      PARAMETER (IIC=3,VIC=4,VPF=14)
C
      DOUBLE PRECISION FVAL
      INTEGER S1
      INTEGER IVAL
C
      INTEGER INT
      PARAMETER (INT=278)
C
        S1=YYV(YYPVT-3)
        IF (SYMTYP(S1) .NE. 0) THEN
          IERR=4
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMTYP(S1)=INT
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(IDNINT(FVAL),0.0D0,VIC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1      INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
        VEK4(1)=0
        VEK4(2)=0
        VEK4(3)=0
        VEK4(4)=IWA(4)
        CALL PUT4(VEK4,IIC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMREF(S1)=IWA(3)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE50(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER VEK4(4)
      INTEGER IHELP1,IHELP2,IHELP3,IHELP4,GETIWA
      INTEGER IIS,VIS,IIC,VIC,VPF,IV
      PARAMETER (IIS=1,VIS=2,IIC=3,VIC=4,VPF=14,IV=15)
C
      DOUBLE PRECISION FVAL
      INTEGER S1,S3,S8,S10
      INTEGER IVAL
C
      INTEGER INDEX,INT,INDVAR,I
      PARAMETER (INDEX=276,INT=278,INDVAR=291)
C
        S1=YYV(YYPVT-10)
        S3=YYV(YYPVT-8)
        S8=YYV(YYPVT-3)
        S10=YYV(YYPVT-1)
        IF (SYMTYP(S1) .NE. 0) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMTYP(S1)=INT
        SYMREF(S1)=IWA(3)+1
        IF (SYMTYP(S3) .EQ. 0) THEN
          SYMTYP(S3)=INDVAR
          CALL PUT1(0,0.0D0,IV,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
          IF (IERR .NE. 0) THEN
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
          SYMREF(S3)=IWA(15)
        ELSE IF (SYMTYP(S3) .NE. INDVAR) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IF (SYMTYP(S10) .NE. INDEX) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIS,SYMREF(S10),3,IWA,LIWA,INFOLI)
        IF ((S3 .NE. S8) .OR. (IHELP1 .LE. 0)) THEN
          IERR=33
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        VEK4(1)=1
        VEK4(2)=GETIWA(IIS,SYMREF(S10),4,IWA,LIWA,INFOLI)
        VEK4(3)=0
        VEK4(4)=IWA(4)+1
        CALL PUT4(VEK4,IIC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIC,IWA(3),2,IWA,LIWA,INFOLI)
        DO 1500 I=1,IHELP1
          CALL PUT1(0,0.0D0,VIC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
 1500   CONTINUE
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIS,SYMREF(S10),2,IWA,LIWA,INFOLI)
        DO 1510 I=1,IHELP1
          IHELP2=GETIWA(IIS,SYMREF(S10),5,IWA,LIWA,INFOLI)
          IHELP3=GETIWA(VIS,IHELP2+I-1,0,IWA,LIWA,INFOLI)
          CALL PUT1(IHELP3,0.0D0,IV,SYMREF(S3),LIWA,PLIWA,IWA,LWA,PLWA,
     1              WA,INFOLI,IERR)
          CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
          IF (IERR .NE. 0) THEN
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
          IHELP1=GETIWA(IIC,IWA(3),2,IWA,LIWA,INFOLI)
          IHELP4=GETIWA(IV,SYMREF(S3),0,IWA,LIWA,INFOLI)
          CALL PUT1(IDNINT(FVAL),0.0D0,VIC,IWA(4)-IHELP1+IHELP4,LIWA,
     1              PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
 1510   CONTINUE
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE51(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER IHELP1,IHELP2,GETIWA
      INTEGER IIC,VIC,VPF
      PARAMETER (IIC=3,VIC=4,VPF=14)
C
      DOUBLE PRECISION FVAL
      INTEGER S1,S3
      INTEGER IVAL
C
      INTEGER INT
      PARAMETER (INT=278)
C
        S1=YYV(YYPVT-6)
        S3=YYV(YYPVT-4)
        IF (SYMTYP(S1) .NE. INT) THEN
          IERR=7
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(VIC,S3,0,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IIC,SYMREF(S1),2,IWA,LIWA,INFOLI)
        IF ((IHELP1 .LT. 0) .OR. (IHELP1 .GT. IHELP2)) THEN
          IERR=33
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIC,SYMREF(S1),4,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(VIC,S3,0,IWA,LIWA,INFOLI)
        CALL PUT1(IDNINT(FVAL),0.0D0,VIC,IHELP1+IHELP2-1,LIWA,PLIWA,
     1            IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE52(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER VEK4(4)
      INTEGER IHELP1,IHELP2,IHELP3,IHELP4,IHELP5,IHELP6,IHELP7
      INTEGER IHELP8,IHELP9,GETIWA
      INTEGER IIS,VIS,IIC,VIC,VPF,IV
      PARAMETER (IIS=1,VIS=2,IIC=3,VIC=4,VPF=14,IV=15)
C
      DOUBLE PRECISION FVAL
      INTEGER S1,S3,S5,S10,S12,S14,S16
      INTEGER IVAL
C
      INTEGER INDEX,INT,INDVAR,I,J
      PARAMETER (INDEX=276,INT=278,INDVAR=291)
C
        S1=YYV(YYPVT-16)
        S3=YYV(YYPVT-14)
        S5=YYV(YYPVT-12)
        S10=YYV(YYPVT-7)
        S12=YYV(YYPVT-5)
        S14=YYV(YYPVT-3)
        S16=YYV(YYPVT-1)
        IF (SYMTYP(S1) .NE. 0) THEN
          IERR=4
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMTYP(S1)=INT
        SYMREF(S1)=IWA(3)+1
        IF (SYMTYP(S3) .EQ. 0) THEN
          SYMTYP(S3)=INDVAR
          CALL PUT1(0,0.0D0,IV,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
          IF (IERR .NE. 0) THEN
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
          SYMREF(S3)=IWA(15)
        ELSE IF (SYMTYP(S3) .NE. INDVAR) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IF (SYMTYP(S5) .EQ. 0) THEN
          SYMTYP(S5)=INDVAR
          CALL PUT1(0,0.0D0,IV,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
          IF (IERR .NE. 0) THEN
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
          SYMREF(S5)=IWA(15)
        ELSE IF (SYMTYP(S5) .NE. INDVAR) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IF ((SYMTYP(S12) .NE. INDEX) .OR. 
     1      (SYMTYP(S16) .NE. INDEX)) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIS,SYMREF(S12),3,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IIS,SYMREF(S16),3,IWA,LIWA,INFOLI)
        IF ((S3 .NE. S10) .OR. (S5 .NE. S14) .OR. 
     1      (IHELP1 .LE. 0) .OR. (IHELP2 .LE. 0)) THEN
          IERR=33
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        VEK4(1)=2
        VEK4(2)=GETIWA(IIS,SYMREF(S12),4,IWA,LIWA,INFOLI)
        VEK4(3)=GETIWA(IIS,SYMREF(S16),4,IWA,LIWA,INFOLI)
        VEK4(4)=IWA(4)+1
        CALL PUT4(VEK4,IIC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIC,IWA(3),2,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IIC,IWA(3),3,IWA,LIWA,INFOLI)
        DO 1600 I=1,IHELP1*IHELP2
          CALL PUT1(0,0.0D0,VIC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
 1600   CONTINUE
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIS,SYMREF(S12),2,IWA,LIWA,INFOLI)
        DO 1620 I=1,IHELP1
          IHELP2=GETIWA(IIS,SYMREF(S12),5,IWA,LIWA,INFOLI)
          IHELP3=GETIWA(VIS,IHELP2+I-1,0,IWA,LIWA,INFOLI)
          CALL PUT1(IHELP3,0.0D0,IV,SYMREF(S3),LIWA,PLIWA,IWA,LWA,PLWA,
     1              WA,INFOLI,IERR)
          IHELP4=GETIWA(IIS,SYMREF(S16),2,IWA,LIWA,INFOLI)
          DO 1610 J=1,IHELP4
            IHELP5=GETIWA(IIS,SYMREF(S16),5,IWA,LIWA,INFOLI)
            IHELP6=GETIWA(VIS,IHELP5+J-1,0,IWA,LIWA,INFOLI)
            CALL PUT1(IHELP6,0.0D0,IV,SYMREF(S5),LIWA,PLIWA,IWA,LWA,
     1                PLWA,WA,INFOLI,IERR)
            CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
            IF (IERR .NE. 0) THEN
              LNUM=LNUM-1
              GO TO 9999
            ENDIF
          IHELP1=GETIWA(IIC,IWA(3),2,IWA,LIWA,INFOLI)
          IHELP2=GETIWA(IIC,IWA(3),3,IWA,LIWA,INFOLI)
          IHELP7=GETIWA(IV,SYMREF(S3),0,IWA,LIWA,INFOLI)
          IHELP8=GETIWA(IIC,IWA(3),3,IWA,LIWA,INFOLI)
          IHELP9=GETIWA(IV,SYMREF(S5),0,IWA,LIWA,INFOLI)
          CALL PUT1(IDNINT(FVAL),0.0D0,VIC,
     1             IWA(4)-(IHELP1*IHELP2)+(IHELP7-1)*IHELP8+IHELP9,
     2             LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
 1610     CONTINUE
 1620   CONTINUE
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE53(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,PC)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
C
      INTEGER IHELP1,IHELP2,IHELP3,IHELP4,GETIWA
      INTEGER IIC,VIC,VPF
      PARAMETER (IIC=3,VIC=4,VPF=14)
C
      DOUBLE PRECISION FVAL
      INTEGER S1,S3,S5
      INTEGER IVAL
C
      INTEGER INT
      PARAMETER (INT=278)
C
        S1=YYV(YYPVT-8)        
        S3=YYV(YYPVT-6)        
        S5=YYV(YYPVT-4)        
        IF (SYMTYP(S1) .NE. INT) THEN
          IERR=7
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(VIC,S3,0,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(VIC,S5,0,IWA,LIWA,INFOLI)
        IHELP3=GETIWA(IIC,SYMREF(S1),2,IWA,LIWA,INFOLI)
        IHELP4=GETIWA(IIC,SYMREF(S1),3,IWA,LIWA,INFOLI)
        IF ((IHELP1 .LT. 1) .OR. (IHELP1 .GT. IHELP3) .OR.
     1      (IHELP2 .LT. 1) .OR. (IHELP2 .GT. IHELP4)) THEN
          IERR=33
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL PUT1(-1,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        CALL EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIC,SYMREF(S1),4,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(VIC,S3,0,IWA,LIWA,INFOLI)
        IHELP3=GETIWA(IIC,SYMREF(S1),3,IWA,LIWA,INFOLI)
        IHELP4=GETIWA(VIC,S5,0,IWA,LIWA,INFOLI)
        CALL PUT1(IDNINT(FVAL),0.0D0,VIC,
     1           IHELP1+(IHELP2-1)*IHELP3+IHELP4-1,
     2           LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CASE54(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,S9)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15),S9,I
C
      INTEGER VEK4(4)
      INTEGER IHELP1,GETIWA
      INTEGER IIS,IRC,VRC,IV
      PARAMETER (IIS=1,IRC=5,VRC=6,IV=15)
C
      INTEGER S2,S4,S7
C
      INTEGER INDEX,REAL,INDVAR
      PARAMETER (INDEX=276,REAL=277,INDVAR=291)
C
        S2=YYV(YYPVT-8)
        S4=YYV(YYPVT-6)
        S7=YYV(YYPVT-3)
        S9=YYV(YYPVT-1)
        IF (SYMTYP(S2) .NE. 0) THEN
          IERR=4
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMTYP(S2)=REAL
        SYMREF(S2)=IWA(5)+1
        IF (SYMTYP(S4) .EQ. 0) THEN
          SYMTYP(S4)=INDVAR
          CALL PUT1(0,0.0D0,IV,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
          IF (IERR .NE. 0) THEN
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
          SYMREF(S4)=IWA(15)
        ELSE IF (SYMTYP(S4) .NE. INDVAR) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IF (SYMTYP(S9) .NE. INDEX) THEN
          IERR=8
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IIS,SYMREF(S9),3,IWA,LIWA,INFOLI)
        IF ((S4 .NE. S7) .OR. (IHELP1 .LE. 0)) THEN
          IERR=33
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        VEK4(1)=1
        VEK4(2)=GETIWA(IIS,SYMREF(S9),4,IWA,LIWA,INFOLI)
        VEK4(3)=0
        VEK4(4)=IWA(6)+1
        CALL PUT4(VEK4,IRC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        IHELP1=GETIWA(IRC,IWA(5),2,IWA,LIWA,INFOLI)
        DO 1700 I=1,IHELP1
          CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
 1700   CONTINUE
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CAS131(YYV,YYPVT,SYMTYP,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,INFOLI,IPOL,SPFLAG)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMTYP(MAXSYM),SYMREF(MAXSYM)
      INTEGER LIWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      INTEGER INFOLI(15)
      INTEGER IPOL,SPFLAG
C
      INTEGER VEK4(4)
      INTEGER IRC
      PARAMETER (IRC=5)
C
      INTEGER S2
C
      INTEGER SPLINE
      PARAMETER (SPLINE=282)
C
        SPFLAG=1
        S2=YYV(YYPVT-1)
        IPOL=S2
        IF (SYMTYP(S2) .NE. 0) THEN
          IERR=4
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
        SYMTYP(S2)=SPLINE
        SYMREF(S2)=IWA(5)+1
        VEK4(1)=1
        VEK4(2)=0
        VEK4(3)=0
        VEK4(4)=IWA(6)+1
        CALL PUT4(VEK4,IRC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
        IF (IERR .NE. 0) THEN
          LNUM=LNUM-1
          GO TO 9999
        ENDIF
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CAS134(YYV,YYPVT,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IPOL)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER IPOL
C
      INTEGER VEK4(4)
      INTEGER IHELP1,IHELP2,GETIWA
      DOUBLE PRECISION HELP3,HELP4,GETWA
      INTEGER IRC,VRC
      PARAMETER (IRC=5,VRC=6)
C
      INTEGER S1,S2
C
        S1=YYV(YYPVT-2)
        S2=YYV(YYPVT-1)
        IHELP1=GETIWA(IRC,SYMREF(IPOL),2,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IRC,SYMREF(IPOL),4,IWA,LIWA,INFOLI)
        IF ( ((IHELP1+2)-(IWA(6)-IHELP2)-1) .EQ. 2 ) THEN
          HELP3=GETWA(VRC,S1,WA,LWA,INFOLI)
          HELP4=GETWA(VRC,S2,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
          CALL PUT1(0,HELP4,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
        ELSE IF ( ((IHELP1+2)-(IWA(6)-IHELP2)-1) .EQ. 1 ) THEN
          HELP3=GETWA(VRC,S1,WA,LWA,INFOLI)
          HELP4=GETWA(VRC,S2,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,IWA(6),LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1              INFOLI,IERR)
          CALL PUT1(0,HELP4,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
        ELSE
          HELP3=GETWA(VRC,S1,WA,LWA,INFOLI)
        ENDIF
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IHELP1 .GT. 0) THEN
          HELP4=GETWA(VRC,IWA(6)-9,WA,LWA,INFOLI)
          IF (HELP3 .LE. HELP4) THEN
            IERR= 63
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
        ENDIF
        VEK4(1)=1
        VEK4(2)=5+IHELP1
        VEK4(3)=0
        VEK4(4)=GETIWA(IRC,SYMREF(IPOL),4,IWA,LIWA,INFOLI)
        CALL PUT4(VEK4,IRC,SYMREF(IPOL),LIWA,PLIWA,IWA,INFOLI,IERR)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CAS135(YYV,YYPVT,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IPOL)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER IPOL
C
      INTEGER VEK4(4)
      INTEGER IHELP1,IHELP2,GETIWA
      DOUBLE PRECISION HELP3,HELP4,GETWA
      INTEGER IRC,VRC
      PARAMETER (IRC=5,VRC=6)
C
      INTEGER S1,S3
C
        S1=YYV(YYPVT-3)
        S3=YYV(YYPVT-1)
        IHELP1=GETIWA(IRC,SYMREF(IPOL),2,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IRC,SYMREF(IPOL),4,IWA,LIWA,INFOLI)
        IF ( ((IHELP1+2)-(IWA(6)-IHELP2)-1) .EQ. 2 ) THEN
          HELP3=GETWA(VRC,S1,WA,LWA,INFOLI)
          HELP4=-GETWA(VRC,S3,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
          CALL PUT1(0,HELP4,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
        ELSE IF ( ((IHELP1+2)-(IWA(6)-IHELP2)-1) .EQ. 1 ) THEN
          HELP3=GETWA(VRC,S1,WA,LWA,INFOLI)
          HELP4=-GETWA(VRC,S3,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,IWA(6),LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1              INFOLI,IERR)
          CALL PUT1(0,HELP4,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
        ELSE
          HELP3=GETWA(VRC,S1,WA,LWA,INFOLI)
          HELP4=-GETWA(VRC,S3,WA,LWA,INFOLI)
          CALL PUT1(0,HELP4,VRC,IWA(6),LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1              INFOLI,IERR)
        ENDIF
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IHELP1 .GT. 0) THEN
          HELP4=GETWA(VRC,IWA(6)-9,WA,LWA,INFOLI)
          IF (HELP3 .LE. HELP4) THEN
            IERR= 63
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
        ENDIF
        VEK4(1)=1
        VEK4(2)=5+IHELP1
        VEK4(3)=0
        VEK4(4)=GETIWA(IRC,SYMREF(IPOL),4,IWA,LIWA,INFOLI)
        CALL PUT4(VEK4,IRC,SYMREF(IPOL),LIWA,PLIWA,IWA,INFOLI,IERR)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CAS136(YYV,YYPVT,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IPOL)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER IPOL
C
      INTEGER VEK4(4)
      INTEGER IHELP1,IHELP2,GETIWA
      DOUBLE PRECISION HELP3,HELP4,GETWA
      INTEGER IRC,VRC
      PARAMETER (IRC=5,VRC=6)
C
      INTEGER S2,S3
C
        S2=YYV(YYPVT-2)
        S3=YYV(YYPVT-1)
        IHELP1=GETIWA(IRC,SYMREF(IPOL),2,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IRC,SYMREF(IPOL),4,IWA,LIWA,INFOLI)
        IF ( ((IHELP1+2)-(IWA(6)-IHELP2)-1) .EQ. 2 ) THEN
          HELP3=-GETWA(VRC,S2,WA,LWA,INFOLI)
          HELP4=GETWA(VRC,S3,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
          CALL PUT1(0,HELP4,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
        ELSE IF ( ((IHELP1+2)-(IWA(6)-IHELP2)-1) .EQ. 1 ) THEN
          HELP3=-GETWA(VRC,S2,WA,LWA,INFOLI)
          HELP4=GETWA(VRC,S3,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,IWA(6),LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1              INFOLI,IERR)
          CALL PUT1(0,HELP4,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
        ELSE
          HELP3=-GETWA(VRC,S2,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,S2,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1              INFOLI,IERR)
        ENDIF
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IHELP1 .GT. 0) THEN
          HELP4=GETWA(VRC,IWA(6)-9,WA,LWA,INFOLI)
          IF (HELP3 .LE. HELP4) THEN
            IERR= 63
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
        ENDIF
        VEK4(1)=1
        VEK4(2)=5+IHELP1
        VEK4(3)=0
        VEK4(4)=GETIWA(IRC,SYMREF(IPOL),4,IWA,LIWA,INFOLI)
        CALL PUT4(VEK4,IRC,SYMREF(IPOL),LIWA,PLIWA,IWA,INFOLI,IERR)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE CAS137(YYV,YYPVT,SYMREF,MAXSYM,IERR,LNUM,
     1                  LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IPOL)
C
      INTEGER YYPVT,YYV(0:149)
      INTEGER MAXSYM,SYMREF(MAXSYM)
      INTEGER LWA,LIWA,PLWA,PLIWA,IERR,LNUM
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER IPOL
C
      INTEGER VEK4(4)
      INTEGER IHELP1,IHELP2,GETIWA
      DOUBLE PRECISION HELP3,HELP4,GETWA
      INTEGER IRC,VRC
      PARAMETER (IRC=5,VRC=6)
C
      INTEGER S2,S4
C
        S2=YYV(YYPVT-3)
        S4=YYV(YYPVT-1)
        IHELP1=GETIWA(IRC,SYMREF(IPOL),2,IWA,LIWA,INFOLI)
        IHELP2=GETIWA(IRC,SYMREF(IPOL),4,IWA,LIWA,INFOLI)
        IF ( ((IHELP1+2)-(IWA(6)-IHELP2)-1) .EQ. 2 ) THEN
          HELP3=-GETWA(VRC,S2,WA,LWA,INFOLI)
          HELP4=-GETWA(VRC,S4,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
          CALL PUT1(0,HELP4,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
        ELSE IF ( ((IHELP1+2)-(IWA(6)-IHELP2)-1) .EQ. 1 ) THEN
          HELP3=-GETWA(VRC,S2,WA,LWA,INFOLI)
          HELP4=-GETWA(VRC,S4,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,IWA(6),LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1              INFOLI,IERR)
          CALL PUT1(0,HELP4,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     1              IERR)
        ELSE
          HELP3=-GETWA(VRC,S2,WA,LWA,INFOLI)
          HELP4=-GETWA(VRC,S4,WA,LWA,INFOLI)
          CALL PUT1(0,HELP3,VRC,S2,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1              INFOLI,IERR)
          CALL PUT1(0,HELP4,VRC,S4,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1              INFOLI,IERR)
        ENDIF
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IHELP1 .GT. 0) THEN
          HELP4=GETWA(VRC,IWA(6)-9,WA,LWA,INFOLI)
          IF (HELP3 .LE. HELP4) THEN
            IERR= 63
            LNUM=LNUM-1
            GO TO 9999
          ENDIF
        ENDIF
        VEK4(1)=1
        VEK4(2)=5+IHELP1
        VEK4(3)=0
        VEK4(4)=GETIWA(IRC,SYMREF(IPOL),4,IWA,LIWA,INFOLI)
        CALL PUT4(VEK4,IRC,SYMREF(IPOL),LIWA,PLIWA,IWA,INFOLI,IERR)
C
 9999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE SYMINP (INPUT,SYMFIL,WA,LWA,IWA,LIWA,PLWA,PLIWA,
     1                   IERR,LNUM,MODE,NVAR,NFUNC,DBGFIL,DBGLVL)
      INTEGER INPUT,SYMFIL
      INTEGER LWA,LIWA
      DOUBLE PRECISION WA(LWA)
      INTEGER IWA(LIWA)
      INTEGER PLWA,PLIWA
      INTEGER IERR,LNUM,MODE,NVAR,NFUNC,DBGFIL,DBGLVL
C
      INTEGER IIS,VIS,IIC,VIC,IRC,VRC,IVA,VVA,IFN,VFN,VPF,IV
      PARAMETER (IIS=1,VIS=2,IIC=3,VIC=4,IRC=5,VRC=6,IVA=7,VVA=8)
      PARAMETER (IFN=9,VFN=11,VPF=14,IV=15)
      INTEGER INFOLI(15),VEK3(3),VEK4(4),VEK5(5),VEK7(7)
      INTEGER I,GETIWA
C
      INTEGER OUTPUT
C     PARAMETER (OUTPUT=7)
C
      INTEGER GSMDEP
      PARAMETER (GSMDEP=10)
C
      INTEGER HSMDEP
      PARAMETER (HSMDEP=10)
C
      INTEGER NOGRAD,GRAD,HESS
      PARAMETER (NOGRAD=0,GRAD=1,HESS=2)
C
C-----------------------------------------------------------------------
      CALL NEXTID(OUTPUT)
C-----------------------------------------------------------------------
      PLIWA=15
      PLWA=0
      NVAR=0
      NFUNC=0
      DO 1 I=1,3
        VEK3(I)=0
1     CONTINUE
      DO 2 I=1,4
        VEK4(I)=0
2     CONTINUE
      DO 3 I=1,5
        VEK5(I)=0
3     CONTINUE
      DO 4 I=1,7
        VEK7(I)=0
4     CONTINUE
      DO 8 I=1,LWA
        WA(I)=0.0D0
8     CONTINUE
      DO 9 I=1,LIWA
        IWA(I)=0
9     CONTINUE
C
      IERR=1
      LNUM=0
      OPEN(OUTPUT,STATUS='SCRATCH',ERR=99)
      CALL YYPRE(INPUT,OUTPUT,IERR,LNUM)
      REWIND(OUTPUT)
      IF (IERR .NE. 0) RETURN
      CALL YYPAR (OUTPUT,WA,LWA,IWA,LIWA,PLWA,PLIWA,MODE,IERR,LNUM,
     1            DBGFIL,DBGLVL)
      CLOSE(OUTPUT)
      IF (IERR .NE. 0) RETURN
C
      INFOLI(1)=15
      INFOLI(2)=IWA(1)*5+INFOLI(1)
      INFOLI(3)=IWA(2)+INFOLI(2)
      INFOLI(4)=IWA(3)*4+INFOLI(3)
      INFOLI(5)=IWA(4)+INFOLI(4)
      INFOLI(7)=IWA(5)*4+INFOLI(5)
      INFOLI(9)=IWA(7)*3+INFOLI(7)
      INFOLI(14)=IWA(9)*7+INFOLI(9)
      INFOLI(15)=IWA(14)+INFOLI(14)
C
      INFOLI(6)=0
      INFOLI(8)=IWA(6)+INFOLI(6)
      INFOLI(11)=IWA(8)+INFOLI(8)
      INFOLI(12)=IWA(11)+INFOLI(11)
      INFOLI(13)=IWA(12)*IWA(8)+INFOLI(12)
C
      IF (IWA(1) .EQ. 0) 
     1  CALL PUT5(VEK5,IIS,0,LIWA,PLIWA,IWA,INFOLI,IERR)
      IF (IWA(2) .EQ. 0) 
     1  CALL PUT1(0,0.0D0,VIS,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
      IF (IWA(3) .EQ. 0) 
     1  CALL PUT4(VEK4,IIC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
      IF (IWA(4) .EQ. 0) 
     1  CALL PUT1(0,0.0D0,VIC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
      IF (IWA(5) .EQ. 0) 
     1  CALL PUT4(VEK4,IRC,0,LIWA,PLIWA,IWA,INFOLI,IERR)
      IF (IWA(6) .EQ. 0) 
     1  CALL PUT1(0,0.0D0,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
      IF (IWA(7) .EQ. 0) 
     1  CALL PUT3(VEK3,IVA,0,LIWA,PLIWA,IWA,INFOLI,IERR)
      IF (IWA(8) .EQ. 0) 
     1  CALL PUT1(0,0.0D0,VVA,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
      IF (IWA(9) .EQ. 0) 
     1  CALL PUT7(VEK7,IFN,0,LIWA,PLIWA,IWA,INFOLI,IERR)
      IF (IWA(11) .EQ. 0)
     1  CALL PUT1(0,0.0D0,VFN,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
C     IF (IWA(12) .EQ. 0) 
C    1  CALL PUT1(0,0.0D0,VGR,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
C     IF (IWA(13) .EQ. 0) 
C    1  IWA(13)=IWA(13)+1
      IF (IWA(14) .EQ. 0) 
     1  CALL PUT1(0,0.0D0,VPF,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
      IF (IWA(15) .EQ. 0) 
     1  CALL PUT1(0,0.0D0,IV,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
C
      NVAR=IWA(8)
      NFUNC=IWA(10)
      DO 50 I=1,IWA(9)
      IF (GETIWA(IFN,I,1,IWA,LIWA,INFOLI).EQ.1) THEN
        NFUNC=NFUNC + GETIWA(IFN,I,3,IWA,LIWA,INFOLI)-1
      ENDIF
   50 CONTINUE
      IF (SYMFIL.GT.0) THEN
        DO 90 I=1,PLIWA-IWA(15)
          WRITE(SYMFIL,'(I6)',ERR=95) IWA(I)
 90     CONTINUE
        DO 91 I=1,IWA(6)
          WRITE(SYMFIL,'(D24.17)',ERR=95) WA(I)
 91     CONTINUE
      ENDIF
      IF (MODE .EQ. NOGRAD) THEN
        PLWA=IWA(6)+IWA(8)+IWA(11)+GSMDEP*IWA(8)+HSMDEP+2
      ELSE IF (MODE .EQ. GRAD) THEN
        PLWA=IWA(6)+IWA(8)+IWA(11)+IWA(11)*IWA(8)+GSMDEP*IWA(8)+
     1       HSMDEP+1
      ELSE IF (MODE .EQ. HESS) THEN
        PLWA=IWA(6)+IWA(8)+IWA(11)+IWA(11)*IWA(8)+GSMDEP*IWA(8)+
     1       IWA(11)*IWA(8)*IWA(8)+HSMDEP*IWA(8)*IWA(8)
      ELSE
        IERR=60
      ENDIF
      IF (PLWA .GT. LWA) THEN
        IERR=32
        RETURN
      ENDIF
      RETURN
 95   IERR=26
 99   RETURN
      END
C
C
C
      SUBROUTINE KLEIN (D,BUCHST)
      CHARACTER D 
      LOGICAL BUCHST
C 
      CHARACTER DAK,DZK
      DAK='a'
      DZK='z'
      BUCHST = ((ICHAR(DAK) .LE. ICHAR(D)) .AND.
     1          (ICHAR(D) .LE. ICHAR(DZK)))
      RETURN
      END
C
C
C
      SUBROUTINE UPCASE (D)
      CHARACTER D
C
      CHARACTER DAK,DAG
      DAK='a'
      DAG='A'
      D = CHAR(ICHAR(D)+ICHAR(DAG)-ICHAR(DAK))
      RETURN
      END
C
C
C
      CHARACTER FUNCTION GETCHR (FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
      PARAMETER (MAXCOLS=128,MAXCOLS1=122)
      INTEGER FD,LNUM,LPOS,SPOS
C      CHARACTER STAR*5,CONT*1,LINE*66
      CHARACTER STAR*5,CONT*1,LINE*122
      LOGICAL EOF
C
      CHARACTER D
      LOGICAL BUCHST
C
C      IF (LPOS .GE. 67) THEN
      IF (LPOS .GE. MAXCOLS-5) THEN
 5      LNUM=LNUM+1
        READ(FD,'(A5,A1,A122)',END=10) STAR,CONT,LINE
        IF ((STAR(1:1) .EQ. 'C') .OR. (STAR(1:1) .EQ. 'c') .OR.
     1    (LINE .EQ. ' ')) GO TO 5
        IF (CONT .EQ. ' ' .OR. CONT .EQ. '0') THEN
          GETCHR='#'
          LPOS=1
          SPOS=2
          RETURN
        ELSE
          LPOS=1
          SPOS=2
        ENDIF
      ENDIF
      IF (STAR(1:1) .EQ. '*') THEN
        GETCHR='@'
        STAR(1:1)=' '
        RETURN
      ENDIF
      IF (SPOS .LE. 5) THEN
        D=STAR(SPOS:SPOS)
        CALL KLEIN(D,BUCHST)
        IF (BUCHST) CALL UPCASE(D)
        GETCHR=D
        SPOS=SPOS+1
        RETURN
      ENDIF
      D=LINE(LPOS:LPOS)
      LPOS=LPOS+1
      CALL KLEIN(D,BUCHST)
      IF (BUCHST) CALL UPCASE(D)
      GETCHR=D
      RETURN
 10   GETCHR='#'
      EOF=.TRUE.
      RETURN
      END
C
C
C
      SUBROUTINE UNGTC (LPOS,IERR)
C
      INTEGER LPOS
      INTEGER IERR
C
      IF (LPOS .GT. 1) THEN
        LPOS=LPOS-1
      ELSE
        IERR=48
      ENDIF
      RETURN
      END
C
C
C
      INTEGER FUNCTION KEYWD (STRING,YYLVAL,IERR)
      CHARACTER*(*) STRING
      INTEGER YYLVAL,IERR
C
      INTEGER RELOP,AND,OR,NOT,ID,SUM,PROD,IN,IF,THEN,ELSE
      INTEGER ENDIF,STDRD,EXTERN,GOTO,CONTIN
      PARAMETER (RELOP=258,AND=259,OR=260,NOT=261,ID=264)
      PARAMETER (SUM=265,PROD=266,IN=267,IF=268,THEN=269)
      PARAMETER (ELSE=270,ENDIF=271,STDRD=272,EXTERN=273)
      PARAMETER (GOTO=287,CONTIN=289)
C
      INTEGER MAXSTD,MAXEXT
      PARAMETER (MAXSTD=17,MAXEXT=1)
C
      CHARACTER*6 STDNAM(MAXSTD),ALTNAM(MAXSTD),EXTNAM(MAXEXT)
      CHARACTER*4 RELNAM(6)
C
      INTEGER I
C
      DATA STDNAM /'DABS','DSQRT','DEXP','DLOG','DLOG10',
     1             'DSIN','DCOS','DTAN','DASIN','DACOS','DATAN',
     2             'DSINH','DCOSH','DTANH','DASINH','DACOSH','DATANH'/
      DATA ALTNAM /'ABS','SQRT','EXP','LOG','LOG10',
     1             'SIN','COS','TAN','ASIN','ACOS','ATAN',
     2             'SINH','COSH','TANH','ASINH','ACOSH','ATANH'/
      DATA EXTNAM /'SIMPSN'/
      DATA RELNAM /'.EQ.','.NE.','.LT.','.LE.','.GT.','.GE.'/
C
      IF (STRING(1:1) .NE. '.') THEN
        IF (STRING .EQ. 'SUM') THEN
          KEYWD=SUM
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. 'PROD') THEN
          KEYWD=PROD
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. 'IN') THEN
          KEYWD=IN
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. 'IF') THEN
          KEYWD=IF
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. 'THEN') THEN
          KEYWD=THEN
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. 'ELSE') THEN
          KEYWD=ELSE
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. 'ENDIF') THEN
          KEYWD=ENDIF
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. 'GOTO') THEN
          KEYWD=GOTO
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. 'CONTINUE') THEN
          KEYWD=CONTIN
          YYLVAL=0
          RETURN
        ENDIF
        DO 10 I=1,MAXSTD
          IF ((STRING .EQ. STDNAM(I)) .OR. (STRING .EQ. ALTNAM(I))) THEN
            KEYWD=STDRD
            YYLVAL=I
            RETURN
          ENDIF
 10     CONTINUE
        DO 20 I=1,MAXEXT
          IF (STRING .EQ. EXTNAM(I)) THEN
            KEYWD=EXTERN
            YYLVAL=I
            RETURN
          ENDIF
 20     CONTINUE
        KEYWD=ID
        YYLVAL=0
        RETURN
      ELSE
        DO 30 I=1,6
          IF (STRING .EQ. RELNAM(I)) THEN
            KEYWD=RELOP
            YYLVAL=I
            RETURN
          ENDIF
 30     CONTINUE
        IF (STRING .EQ. '.AND.') THEN
          KEYWD=AND
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. '.OR.') THEN
          KEYWD=OR
          YYLVAL=0
          RETURN
        ENDIF
        IF (STRING .EQ. '.NOT.') THEN
          KEYWD=NOT
          YYLVAL=0
          RETURN
        ENDIF
        KEYWD=0
        IERR=11
        RETURN
      ENDIF
      END
C
C
C
      INTEGER FUNCTION INSERT (STRING,STRLEN,TYPE,LIWA,PLIWA,IWA,LWA,
     1                         PLWA,WA,INFOLI,MAXSYM,SYMNAM,SYMTYP,
     2                         SYMREF,SYMEND,IERR)
      CHARACTER*(*) STRING
      INTEGER STRLEN,TYPE
      INTEGER LIWA,PLIWA,LWA,PLWA
      INTEGER IWA(LIWA),INFOLI(15)
      DOUBLE PRECISION WA(LWA)
      INTEGER MAXSYM
      CHARACTER*20 SYMNAM(MAXSYM)
      INTEGER SYMTYP(MAXSYM),SYMREF(MAXSYM),SYMEND
      INTEGER IERR
C
      INTEGER INUM,RNUM,ID,GETIWA
      PARAMETER (INUM=262,RNUM=263,ID=264)
C
      INTEGER VIC,VRC
      PARAMETER (VIC=4,VRC=6)
C
      INTEGER I,X
      INTEGER IHELP
      DOUBLE PRECISION Y,GETWA,RHELP
      CHARACTER*40 COPY
C
      INSERT=0
      IF ((TYPE .EQ. INUM) .OR. (TYPE .EQ. RNUM)) THEN
        COPY=' '
        COPY(40-STRLEN+1:40)=STRING(1:STRLEN)
      ENDIF
      IF (TYPE .EQ. INUM) THEN
        READ(COPY,'(I40)',ERR=11) X
        DO 10 I=1,IWA(4)
          IHELP=GETIWA(VIC,I,0,IWA,LIWA,INFOLI)
          IF (X .EQ. IHELP) THEN
            INSERT=I
            RETURN
          ENDIF
 10     CONTINUE
        CALL PUT1(X,0.0D0,VIC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) RETURN
        INSERT=IWA(4)
        RETURN
 11     IERR=22
        RETURN
C
      ELSE IF (TYPE .EQ. RNUM) THEN
        READ(COPY,'(D40.17)',ERR=21) Y
        DO 20 I=1,IWA(6)
          RHELP=GETWA(VRC,I,WA,LWA,INFOLI)
          IF (Y .EQ. RHELP) THEN
            INSERT=I
            RETURN
          ENDIF
 20     CONTINUE
        CALL PUT1(0,Y,VRC,0,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,IERR)
        IF (IERR .NE. 0) RETURN
        INSERT=IWA(6)
        RETURN
 21     IERR=23
        RETURN
C
      ELSE IF (TYPE .EQ. ID) THEN
        DO 30 I=1,SYMEND
          IF (STRING(1:STRLEN) .EQ. SYMNAM(I)) THEN
            INSERT=I
            RETURN
          ENDIF
 30     CONTINUE
        IF (SYMEND .GE. MAXSYM) THEN
          IERR=32
          RETURN
        ENDIF
        SYMEND=SYMEND+1
        SYMNAM(SYMEND)=STRING(1:STRLEN)
        SYMTYP(SYMEND)=0
        SYMREF(SYMEND)=0
        INSERT=SYMEND
        RETURN
C
      ELSE
        IERR=26
        WRITE(*,*) ' INSERT (5787) : unknown type ',TYPE
      ENDIF
      END
C
C
      INTEGER FUNCTION YYLEX (FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF,
     1                        YYLVAL,LIWA,PLIWA,IWA,LWA,PLWA,WA,INFOLI,
     2                        MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR,
     3                        DBGFIL,DBGLVL)
      PARAMETER (MAXCOLS=128,MAXCOLS1=122)
      INTEGER FD,LNUM,LPOS,SPOS
C      CHARACTER STAR*5,CONT*1,LINE*66
      CHARACTER STAR*5,CONT*1,LINE*122
      LOGICAL EOF
      INTEGER YYLVAL
      INTEGER LIWA,PLIWA,LWA,PLWA
      INTEGER IWA(LIWA),INFOLI(15)
      DOUBLE PRECISION WA(LWA)
      INTEGER MAXSYM
      CHARACTER*20 SYMNAM(MAXSYM)
      INTEGER SYMTYP(MAXSYM),SYMREF(MAXSYM),SYMEND
      INTEGER IERR,DBGFIL,DBGLVL
C
      INTEGER ADD,SUB,MULT,DIV,POWER,LEFT,RIGHT,COMMA,ASSIGN,NLINE
      INTEGER RANGE,RELOP,AND,OR,NOT,INUM,RNUM,ID,SUM,PROD,IN,IF,THEN
      INTEGER ELSE,ENDIF,STDRD,EXTERN,INTERP,PARAM
      INTEGER CONINT,LININT,SPLINE,GOTO,MARKE,CONTIN
      PARAMETER (ADD=43,SUB=45,MULT=42,DIV=47,POWER=94,LEFT=40,RIGHT=41)
      PARAMETER (COMMA=44,ASSIGN=61,NLINE=10,RANGE=257,RELOP=258)
      PARAMETER (AND=259,OR=260,NOT=261,INUM=262,RNUM=263,ID=264)
      PARAMETER (SUM=265,PROD=266,IN=267,IF=268,THEN=269,ELSE=270)
      PARAMETER (ENDIF=271,STDRD=272,EXTERN=273,INTERP=274,PARAM=275)
      PARAMETER (CONINT=280)
      PARAMETER (LININT=281,SPLINE=282)
      PARAMETER (GOTO=287,MARKE=288,CONTIN=289)
C
      INTEGER       TYPNUM
      PARAMETER (TYPNUM=12)
      CHARACTER*24  TYPNAM(TYPNUM)
      INTEGER       TYPLEN(TYPNUM)
C
      INTEGER      I,INSERT,J,KEYWD,STRLEN,K
      LOGICAL      BUCHST,ZIFFER,DEBUG, RFLAG
      CHARACTER    C,C2,GETCHR,STRING*40
C
      BUCHST(C) = (('A' .LE. C) .AND. (C .LE. 'Z') .OR. (C .EQ. '_'))
      ZIFFER(C) = (('0' .LE. C) .AND. (C .LE. '9'))
C
      DATA TYPNAM /'PARAMETER','SETOFINDICES','REALCONSTANT',
     1             'INTEGERCONSTANT','TABLE','CONINT','LININT',
     2             'SPLINE','VARIABLE','INDEX','FUNCTION','END'/
      DATA TYPLEN /9,12,12,15,5,6,6,6,8,5,8,3/
C
      DEBUG=((DBGLVL .EQ. 1) .OR. (DBGLVL .EQ. 3))
      RFLAG=.FALSE.
      STRLEN=0
      IF (EOF .OR. (IERR .NE. 0)) THEN
        YYLEX=-1
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: End of file'
        RETURN
      ENDIF
 10   C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
      IF (C .EQ. ' ') GO TO 10
C20   IF (C .EQ. '(') THEN
      IF (C .EQ. '(') THEN
        YYLEX=LEFT
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: "("'
        RETURN
      ENDIF
C30   IF (C .EQ. ')') THEN
      IF (C .EQ. ')') THEN
        YYLEX=RIGHT
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: ")"'
        RETURN
      ENDIF
C40   IF (C .EQ. '+') THEN
      IF (C .EQ. '+') THEN
        YYLEX=ADD
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: "+"'
        RETURN
      ENDIF
C50   IF (C .EQ. '-') THEN
      IF (C .EQ. '-') THEN
        YYLEX=SUB
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: "-"'
        RETURN
      ENDIF
C60   IF (C .EQ. '*') THEN
      IF (C .EQ. '*') THEN
        C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
        IF (C .EQ. '*') THEN
          YYLEX=POWER
          YYLVAL=0
          IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: "**"'
          RETURN
        ELSE
          YYLEX=MULT
          YYLVAL=0
          IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: "*"'
          CALL UNGTC(LPOS,IERR)
          RETURN
        ENDIF
      ENDIF
C70   IF (C .EQ. '/') THEN
      IF (C .EQ. '/') THEN
        YYLEX=DIV
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: "/"'
        RETURN
      ENDIF
C80   IF (C .EQ. '=') THEN
      IF (C .EQ. '=') THEN
        YYLEX=ASSIGN
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: "="'
        RETURN
      ENDIF
C90   IF (C .EQ. ',') THEN
      IF (C .EQ. ',') THEN
        YYLEX=COMMA
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: ","'
        RETURN
      ENDIF
C100  IF (C .NE. '.') GO TO 110
      IF (C .NE. '.') GO TO 110
      C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
      IF (C .EQ. '.') THEN
        YYLEX=RANGE
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: ".."'
        YYLVAL=0
        RETURN
      ELSE IF (ZIFFER(C)) THEN
        STRING='.'
        STRLEN=1
        RFLAG=.TRUE.
        GO TO 113
      ELSE IF (.NOT. BUCHST(C)) THEN
        YYLEX=-1
        IERR=13
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: Range operator expected!'
        RETURN
      ENDIF
      STRING='.'//C
      STRLEN=2
 101  C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
      IF (BUCHST(C)) THEN
        STRLEN=STRLEN+1
        STRING(STRLEN:STRLEN)=C
        GO TO 101
      ELSE IF (C .EQ. '.') THEN
        STRLEN=STRLEN+1
        STRING(STRLEN:STRLEN)=C
      ENDIF
      YYLEX=KEYWD(STRING,YYLVAL,IERR)
      IF (IERR .NE. 0) THEN
        YYLEX=-1
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: Keyword expected!'
      ENDIF
      IF (DEBUG) THEN
      IF (YYLEX .EQ. RELOP) THEN
      WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Relational operator "',
     1                        STRING(1:STRLEN),'"'
      ELSE IF (YYLEX .EQ. AND) THEN
      WRITE(DBGFIL,'(A)') 'YYLEX: ".AND."'
      ELSE IF (YYLEX .EQ. OR) THEN
      WRITE(DBGFIL,'(A)') 'YYLEX: ".OR."'
      ELSE IF (YYLEX .EQ. NOT) THEN
      WRITE(DBGFIL,'(A)') 'YYLEX: ".NOT."'
      ELSE 
      WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Unknown keyword "',
     1                        STRING(1:STRLEN),'"'
      ENDIF
      ENDIF
      RETURN
 110  IF (.NOT. ZIFFER(C)) GO TO 120
      STRING=C
      STRLEN=1
      IF (LPOS .EQ. 1) THEN
 111    C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
        IF ((ZIFFER(C)) .AND. (SPOS .LE. 6)) THEN
          STRLEN=STRLEN+1
          STRING(STRLEN:STRLEN)=C
          GO TO 111
        ELSE
          YYLEX=MARKE
          YYLVAL=INSERT(STRING,STRLEN,INUM,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1                  INFOLI,MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR)
          IF (DEBUG) WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Label "',
     1                                       STRING(1:STRLEN),'"'
          IF ((SPOS .EQ. 6) .AND. (C .EQ. ' ')) LPOS=LPOS+1
          IF (SPOS .EQ. 6) THEN
            CALL UNGTC(LPOS,IERR)
          ELSE
            CALL UNGTC(SPOS,IERR)
          ENDIF
          IF (CONT .NE. ' ') IERR=31
          RETURN
        ENDIF
      ELSE
 112    C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
        IF (ZIFFER(C)) THEN
          STRLEN=STRLEN+1
          STRING(STRLEN:STRLEN)=C
          GO TO 112
        ELSE IF (C .EQ. 'D' .OR. C .EQ. 'E') THEN
          GO TO 114
        ELSE IF (C .NE. '.') THEN 
          YYLEX=INUM
          YYLVAL=INSERT(STRING,STRLEN,INUM,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1                  INFOLI,MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR)
          IF (DEBUG) WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Integer number "',
     1                                       STRING(1:STRLEN),'"'
          CALL UNGTC(LPOS,IERR)
          RETURN
        ENDIF
      ENDIF
      STRLEN=STRLEN+1
      STRING(STRLEN:STRLEN)='.'
      RFLAG=.TRUE.
      C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
      IF (ZIFFER(C)) THEN
        GO TO 113
      ELSE IF (BUCHST(C)) THEN
        IF (C .EQ. 'D' .OR. C .EQ. 'E') THEN
          GO TO 114
        ELSE
          STRING(STRLEN:STRLEN)=' '
          STRLEN=STRLEN-1
          YYLEX=INUM
          YYLVAL=INSERT(STRING,STRLEN,INUM,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1                  INFOLI,MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR)
          IF (DEBUG) WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Integer number "',
     1                                       STRING(1:STRLEN),'"'
          CALL UNGTC(LPOS,IERR)
          CALL UNGTC(LPOS,IERR)
          RETURN
        ENDIF
      ELSE IF (C .EQ. '.') THEN
        YYLEX=INUM
        STRING(STRLEN:STRLEN)=' '
        STRLEN=STRLEN-1
        YYLVAL=INSERT(STRING,STRLEN,INUM,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1                INFOLI,MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR)
        IF (DEBUG) WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Integer number "',
     1                     STRING(1:STRLEN),'"'
        CALL UNGTC(LPOS,IERR)
        CALL UNGTC(LPOS,IERR)
        RETURN
      ELSE
        YYLEX=RNUM
        YYLVAL=INSERT(STRING,STRLEN,RNUM,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1                INFOLI,MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR)
        IF (DEBUG) WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Real number "',
     1                     STRING(1:STRLEN),'"'
        CALL UNGTC(LPOS,IERR)
        RETURN
      ENDIF
 113  IF (ZIFFER(C)) THEN
        STRLEN=STRLEN+1
        STRING(STRLEN:STRLEN)=C
        C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
        GO TO 113
      ELSE IF (C .NE. 'D' .AND. C .NE. 'E') THEN
        STRLEN=STRLEN+2
        STRING(STRLEN-1:STRLEN)='D0'
        YYLEX=RNUM 
        YYLVAL=INSERT(STRING,STRLEN,RNUM,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1                INFOLI,MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR)
        IF (DEBUG) WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Real number "',
     1                     STRING(1:STRLEN),'"'
        CALL UNGTC(LPOS,IERR)
        RETURN
      ENDIF
 114  IF (.NOT. RFLAG) THEN
        STRLEN=STRLEN+1
        STRING(STRLEN:STRLEN)='.'
      ENDIF
      STRLEN=STRLEN+1
      STRING(STRLEN:STRLEN)='D'
      C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
      IF (BUCHST(C)) THEN
        CALL UNGTC(LPOS,IERR)
        CALL UNGTC(LPOS,IERR)
        STRING(STRLEN:STRLEN)=' '
        STRLEN=STRLEN-1
        YYLEX=RNUM
        YYLVAL=INSERT(STRING,STRLEN,RNUM,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1                INFOLI,MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR)
        IF (DEBUG) WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Real number "',
     1                     STRING(1:STRLEN),'"'
        RETURN
      ELSE IF (ZIFFER(C)) THEN
        GO TO 115
      ELSE IF (C .NE. '+' .AND. C .NE. '-') THEN
        YYLEX=-1
        IERR=23
        IF (DEBUG) WRITE(DBGFIL,'(A)') 
     1    'YYLEX: Wrong format for real number!'
        RETURN
      ENDIF
      STRLEN=STRLEN+1
      STRING(STRLEN:STRLEN)=C
      C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
 115  IF (ZIFFER(C)) THEN
        STRLEN=STRLEN+1
        STRING(STRLEN:STRLEN)=C
        C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
        GO TO 115
      ENDIF
      YYLEX=RNUM
      YYLVAL=INSERT(STRING,STRLEN,RNUM,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1              INFOLI,MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR)
      IF (DEBUG) WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Real number "',
     1                   STRING(1:STRLEN),'"'
      CALL UNGTC(LPOS,IERR)
      RETURN
 120  IF (BUCHST(C)) THEN
        STRING=C
        STRLEN=1
 121    C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
        IF (BUCHST(C) .OR. ZIFFER(C)) THEN
          STRLEN=STRLEN+1
          STRING(STRLEN:STRLEN)=C
          GO TO 121
        ENDIF
        CALL UNGTC(LPOS,IERR)
        YYLEX=KEYWD(STRING,YYLVAL,IERR)
        IF (DEBUG) THEN
        IF (YYLEX .EQ. SUM) THEN
        WRITE(DBGFIL,'(A)') 'YYLEX: "SUM"'
        ELSE IF (YYLEX .EQ. PROD) THEN
        WRITE(DBGFIL,'(A)') 'YYLEX: "PROD"'
        ELSE IF (YYLEX .EQ. IN) THEN
        WRITE(DBGFIL,'(A)') 'YYLEX: "IN"'
        ELSE IF (YYLEX .EQ. IF) THEN
        WRITE(DBGFIL,'(A)') 'YYLEX: "IF"'
        ELSE IF (YYLEX .EQ. THEN) THEN
        WRITE(DBGFIL,'(A)') 'YYLEX: "THEN"'
        ELSE IF (YYLEX .EQ. ELSE) THEN
        WRITE(DBGFIL,'(A)') 'YYLEX: "ELSE"'
        ELSE IF (YYLEX .EQ. ENDIF) THEN
        WRITE(DBGFIL,'(A)') 'YYLEX: "ENDIF"'
        ELSE IF (YYLEX .EQ. GOTO) THEN
        WRITE(DBGFIL,'(A)') 'YYLEX: "GOTO"'
        ELSE IF (YYLEX .EQ. CONTIN) THEN
        WRITE(DBGFIL,'(A)') 'YYLEX: "CONTINUE"'
        ELSE IF (YYLEX .EQ. STDRD) THEN
        WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Standard function "',
     1                      STRING(1:STRLEN),'"'
        ELSE IF (YYLEX .EQ. EXTERN) THEN
        WRITE(DBGFIL,'(A,A,A)') 'YYLEX: External function "',
     1                      STRING(1:STRLEN),'"'
        ELSE IF (YYLEX .EQ. ID) THEN
        WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Identifier "',
     1                      STRING(1:STRLEN),'"'
        ELSE 
        WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Unknown keyword "',
     1                      STRING(1:STRLEN),'"'
        ENDIF
        ENDIF
        IF (STRLEN .GT. 20) THEN
          YYLEX=-1
          IERR=27
          RETURN
        ENDIF
        IF (YYLEX .EQ. ID) THEN
          YYLVAL=INSERT(STRING,STRLEN,ID,LIWA,PLIWA,IWA,LWA,PLWA,WA,
     1                  INFOLI,MAXSYM,SYMNAM,SYMTYP,SYMREF,SYMEND,IERR)
          IF ( (SYMTYP(YYLVAL) .EQ. CONINT) .OR. 
     1         (SYMTYP(YYLVAL) .EQ. LININT) .OR.
     2         (SYMTYP(YYLVAL) .EQ. SPLINE) ) THEN
            YYLEX=INTERP
          ENDIF
        ENDIF
        RETURN
      ENDIF
C130  IF (C .EQ. '@') THEN
      IF (C .EQ. '@') THEN
 131    C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
        IF (C .EQ. ' ') GO TO 131
        J=0
        DO 132 I=1,TYPNUM
          IF (C .EQ. TYPNAM(I)(1:1)) J=I
 132    CONTINUE
        K=0
        IF (C .EQ. 'I') THEN
 160      C2=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
          K=K+1
          IF (C2 .EQ. ' ') GO TO 160
 170      C2=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
          K=K+1
          IF (C2 .EQ. ' ') GO TO 170
          IF (C2 .EQ. 'T') J=4
          DO 180 I=1,K
            CALL UNGTC(LPOS,IERR)
 180      CONTINUE
        ENDIF
        IF (C .EQ. 'S') THEN
 190      C2=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
          K=K+1
          IF (C2 .EQ. ' ') GO TO 190
          IF (C2 .EQ. 'E') J=2
          DO 200 I=1,K
            CALL UNGTC(LPOS,IERR)
 200      CONTINUE
        ENDIF
        STRING=C
        DO 134 I=2,TYPLEN(J)
C133      C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
          C=GETCHR(FD,LNUM,STAR,CONT,LINE,LPOS,SPOS,EOF)
          IF (C .EQ. ' ') THEN
            IF ((STRING(1:3).EQ.'SET').OR.(STRING(1:3).EQ.'REA')
     /         .OR.(STRING(1:3).EQ.'INT')) LPOS=100
            GOTO 135
          ENDIF
          STRING(I:I)=C
 134    CONTINUE
 135    IF (STRING(1:3) .EQ. TYPNAM(J)(1:3)) THEN
          YYLEX=PARAM+(J-1)
          YYLVAL=0
          IF (DEBUG) THEN
          IF (j .EQ. 1) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "PARAMETER"'
          ELSE IF (j .EQ. 2) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "SET OF INDICES"'
          ELSE IF (j .EQ. 3) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "REAL CONSTANT"'
          ELSE IF (j .EQ. 4) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "INTEGER CONSTANT"'
          ELSE IF (j .EQ. 5) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "TABLE"'
          ELSE IF (j .EQ. 6) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "CONINT"'
          ELSE IF (j .EQ. 7) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "LININT"'
          ELSE IF (j .EQ. 8) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "SPLINE"'
          ELSE IF (j .EQ. 9) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "VARIABLE"'
          ELSE IF (j .EQ. 10) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "INDEX"'
          ELSE IF (j .EQ. 11) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "FUNCTION"'
          ELSE IF (j .EQ. 12) THEN 
          WRITE(DBGFIL,'(A)') 'YYLEX: Block "END"'
          ELSE 
          WRITE(DBGFIL,'(A,A,A)') 'YYLEX: Unknown block "',
     1                       STRING(1:STRLEN),'"'
          ENDIF
          ENDIF
          RETURN
        ELSE
          YYLEX=-1
          YYLVAL=0
          IERR=28
          RETURN
        ENDIF
      ENDIF
C140  IF (C .EQ. '#') THEN
      IF (C .EQ. '#') THEN
        YYLEX=NLINE
        YYLVAL=0
        IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: Newline'
        RETURN
      ENDIF
C150  YYLEX=-1
      YYLEX=-1
      IF (DEBUG) WRITE(DBGFIL,'(A)') 'YYLEX: Unknown input character'
      IERR=29
      RETURN
      END
C
C
C
      SUBROUTINE PUT1(IVEK,RVEK,ART,OFFSET,LIWA,PLIWA,IWA,LWA,PLWA,
     1               WA,INFOLI,IERR)
C
      INTEGER ART,LIWA,PLIWA,LWA,PLWA,OFFSET
      INTEGER IVEK,IWA(LIWA),INFOLI(15),IERR
      DOUBLE PRECISION RVEK,WA(LWA)
C
      INTEGER VIS,VIC,VRC,VVA,VFN,VGR,VPF,IV
C     INTEGER LVIS,LIIC,LVIC,LIRC,LVRC,LVVA,LVFN,LVGR,LVHE,LVPF,LIV
      INTEGER LVIS,LIIC,LVIC,LIRC,LVRC,LVVA,LVFN,LVGR,LVPF,LIV
      PARAMETER (VIS=2,VIC=4,VRC=6,VVA=8,VFN=11,VGR=12)
      PARAMETER (VPF=14,IV=15)
C
      INTEGER I
C
      LVIS=INFOLI(2)
      LIIC=INFOLI(3)
      LVIC=INFOLI(4)
      LIRC=INFOLI(5)
      LVPF=INFOLI(14)
      LIV =INFOLI(15)
C
      LVRC=INFOLI(6)
      LVVA=INFOLI(8)
      LVFN=INFOLI(11)
      LVGR=INFOLI(12)
C     LVHE=INFOLI(13)
C
      IF (ART .EQ. VIS) THEN
        IF (OFFSET .EQ. 0) THEN
          IWA(2)=IWA(2)+1
          PLIWA=PLIWA+1
          IF (PLIWA .GT. LIWA) GO TO 9999
          IF (PLIWA-1 .GT. LIIC) THEN
            DO 100 I=PLIWA,LIIC+1+1,-1
              IWA(I)=IWA(I-1)
 100         CONTINUE
          ENDIF
          IWA(IWA(2)+LVIS)=IVEK
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(2))) THEN
          IWA(LVIS+OFFSET)=IVEK
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE IF (ART .EQ. VIC) THEN
        IF (OFFSET .EQ. 0) THEN
          IWA(4)=IWA(4)+1
          PLIWA=PLIWA+1
          IF (PLIWA .GT. LIWA) GO TO 9999
          IF (PLIWA-1 .GT. LIRC) THEN
            DO 300 I=PLIWA,LIRC+1+1,-1
              IWA(I)=IWA(I-1)
 300         CONTINUE
          ENDIF
          IWA(IWA(4)+LVIC)=IVEK
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(4))) THEN
          IWA(LVIC+OFFSET)=IVEK
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE IF (ART .EQ. VRC) THEN
        IF (OFFSET .EQ. 0) THEN
          IWA(6)=IWA(6)+1
          PLWA=PLWA+1
          IF (PLWA .GT. LWA) GO TO 9999
          IF (PLWA-1 .GT. LVVA) THEN
            DO 500 I=PLWA,LVVA+1+1,-1
              WA(I)=WA(I-1)
 500         CONTINUE
          ENDIF
          WA(IWA(6)+LVRC)=RVEK
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(6))) THEN
          WA(LVRC+OFFSET)=RVEK
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE IF (ART .EQ. VVA) THEN
        IF (OFFSET .EQ. 0) THEN
          IWA(8)=IWA(8)+1
          PLWA=PLWA+1
          IF (PLWA .GT. LWA) GO TO 9999
          IF (PLWA-1 .GT. LVFN) THEN
            DO 700 I=PLWA,LVFN+1+1,-1
              WA(I)=WA(I-1)
 700         CONTINUE
          ENDIF
          WA(IWA(8)+LVVA)=RVEK
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(8))) THEN
          WA(LVVA+OFFSET)=RVEK
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE IF (ART .EQ. VFN) THEN
        IF (OFFSET .EQ. 0) THEN
          IWA(11)=IWA(11)+1
          PLWA=PLWA+1
          IF (PLWA .GT. LWA) GO TO 9999
          IF (PLWA-1 .GT. LVGR) THEN
            DO 900 I=PLWA,LVGR+1+1,-1
              WA(I)=WA(I-1)
 900         CONTINUE
          ENDIF
          WA(IWA(11)+LVFN)=RVEK
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(11))) THEN
          WA(LVFN+OFFSET)=RVEK
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE IF (ART .EQ. VGR) THEN
        IF (OFFSET .EQ. 0) THEN
          IWA(12)=IWA(12)+1
          PLWA=PLWA+1
          IF (PLWA .GT. LWA) GO TO 9999
          IF (PLWA-1 .GT. IWA(12)-1+LVGR) THEN
            DO 1000 I=PLWA,IWA(12)-1+LVGR+1+1,-1
              WA(I)=WA(I-1)
 1000       CONTINUE
          ENDIF
          WA(IWA(12)+LVGR)=RVEK
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(12))) THEN
          WA(LVGR+OFFSET)=RVEK
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE IF (ART .EQ. VPF) THEN
        IF (OFFSET .EQ. 0) THEN
          IWA(14)=IWA(14)+1
          PLIWA=PLIWA+1
          IF (PLIWA .GT. LIWA) GO TO 9999
          IF (PLIWA-1 .GT. LIV) THEN
            DO 1100 I=PLIWA,LIV+1+1,-1
              IWA(I)=IWA(I-1)
 1100       CONTINUE
          ENDIF
          IWA(LVPF+IWA(14))=IVEK
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(14))) THEN
          IWA(LVPF+OFFSET)=IVEK
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE IF (ART .EQ. IV) THEN
        IF (OFFSET .EQ. 0) THEN
          IWA(15)=IWA(15)+1
          PLIWA=PLIWA+1
          IF (PLIWA .GT. LIWA) GO TO 9999
          IF (PLIWA-1 .GT. IWA(15)-1+LIV) THEN
            DO 1200 I=PLIWA,IWA(15)-1+LIV+1+1,-1
              IWA(I)=IWA(I-1)
 1200       CONTINUE
          ENDIF
          IWA(LIV+IWA(15))=IVEK
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(15))) THEN
          IWA(LIV+OFFSET)=IVEK
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE
        IERR=34
        RETURN
C
C
      ENDIF
C
      INFOLI(1)=15
      INFOLI(2)=IWA(1)*5+INFOLI(1)
      INFOLI(3)=IWA(2)+INFOLI(2)
      INFOLI(4)=IWA(3)*4+INFOLI(3)
      INFOLI(5)=IWA(4)+INFOLI(4)
      INFOLI(7)=IWA(5)*4+INFOLI(5)
      INFOLI(9)=IWA(7)*3+INFOLI(7)
      INFOLI(14)=IWA(9)*7+INFOLI(9)
      INFOLI(15)=IWA(14)+INFOLI(14)
C
      INFOLI(6)=0
      INFOLI(8)=IWA(6)+INFOLI(6)
      INFOLI(11)=IWA(8)+INFOLI(8)
      INFOLI(12)=IWA(11)+INFOLI(11)
      INFOLI(13)=IWA(12)*IWA(8)+INFOLI(12)
C 
      RETURN
C
 9999 CONTINUE
C     WRITE(*,*) 'OUT OF MEMORY'
      IERR=32
      RETURN
      END
C
C
C
      SUBROUTINE PUT3(IVEK,ART,OFFSET,LIWA,PLIWA,IWA,INFOLI,IERR)
C
      INTEGER ART,LIWA,PLIWA,OFFSET
      INTEGER IVEK(3),IWA(LIWA),INFOLI(15),IERR
C
      INTEGER IVA
      INTEGER LIVA,LIFN
      PARAMETER (IVA=7)
C
      INTEGER I,J
C
      LIVA=INFOLI(7)
      LIFN=INFOLI(9)
C
      IF (ART .EQ. IVA) THEN
C
        IF (OFFSET .EQ. 0) THEN
          IWA(7)=IWA(7)+1
          PLIWA=PLIWA+3
          IF (PLIWA .GT. LIWA) GO TO 9999
          IF (PLIWA-3 .GT. LIFN) THEN
            DO 100 I=PLIWA,LIFN+3+1,-1
              IWA(I)=IWA(I-3)
 100        CONTINUE
          ENDIF
          IF (IWA(7) .GT. 1) THEN
            DO 120 I=3,1,-1
              IWA(LIVA+IWA(7)*I)=IVEK(I)
              DO 110 J=1,IWA(7)-1
                IWA(LIVA+IWA(7)*I-J)=IWA(LIVA+IWA(7)*I-J-(I-1))
 110           CONTINUE
 120         CONTINUE
          ELSE
            DO 130 I=1,3
              IWA(LIVA+I) = IVEK(I)
 130         CONTINUE
          ENDIF
C
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(7))) THEN
          DO 140 I=1,3
            IWA(LIVA+IWA(7)*(I-1)+OFFSET)=IVEK(I)
 140      CONTINUE
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE
        IERR=34
        RETURN
C
C
      ENDIF
C
      INFOLI(1)=15
      INFOLI(2)=IWA(1)*5+INFOLI(1)
      INFOLI(3)=IWA(2)+INFOLI(2)
      INFOLI(4)=IWA(3)*4+INFOLI(3)
      INFOLI(5)=IWA(4)+INFOLI(4)
      INFOLI(7)=IWA(5)*4+INFOLI(5)
      INFOLI(9)=IWA(7)*3+INFOLI(7)
      INFOLI(14)=IWA(9)*7+INFOLI(9)
      INFOLI(15)=IWA(14)+INFOLI(14)
C
      INFOLI(6)=0
      INFOLI(8)=IWA(6)+INFOLI(6)
      INFOLI(11)=IWA(8)+INFOLI(8)
      INFOLI(12)=IWA(11)+INFOLI(11)
      INFOLI(13)=IWA(12)*IWA(8)+INFOLI(12)
C 
      RETURN
C
 9999 CONTINUE
C     WRITE(*,*) 'OUT OF MEMORY'
      IERR=32
      RETURN
      END
C
C
C
      SUBROUTINE PUT4(IVEK,ART,OFFSET,LIWA,PLIWA,IWA,INFOLI,IERR)
C
      INTEGER ART,LIWA,PLIWA,OFFSET
      INTEGER IVEK(4),IWA(LIWA),INFOLI(15),IERR
C
      INTEGER IIC,IRC
      INTEGER LIIC,LVIC,LIRC,LIVA
      PARAMETER (IIC=3,IRC=5)
C
      INTEGER I,J
C
      LIIC=INFOLI(3)
      LVIC=INFOLI(4)
      LIRC=INFOLI(5)
      LIVA=INFOLI(7)
C
      IF (ART .EQ. IIC) THEN
C
        IF (OFFSET .EQ. 0) THEN
          IWA(3)=IWA(3)+1
          PLIWA=PLIWA+4
          IF (PLIWA .GT. LIWA) GO TO 9999
          IF (PLIWA-4 .GT. LVIC) THEN
            DO 100 I=PLIWA,LVIC+1+4,-1
              IWA(I)=IWA(I-4)
 100        CONTINUE
          ENDIF
          IF (IWA(3) .GT. 1) THEN
            DO 120 I=4,1,-1
              IWA(LIIC+IWA(3)*I)=IVEK(I)
              DO 110 J=1,IWA(3)-1
                IWA(LIIC+IWA(3)*I-J)=IWA(LIIC+IWA(3)*I-J-(I-1))
 110          CONTINUE
 120        CONTINUE
          ELSE
            DO 130 I=1,4
              IWA(LIIC+I) = IVEK(I)
 130        CONTINUE
          ENDIF
C
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(3))) THEN
          DO 140 I=1,4
            IWA(LIIC+IWA(3)*(I-1)+OFFSET)=IVEK(I)
 140      CONTINUE
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE IF (ART .EQ. IRC) THEN
C
        IF (OFFSET .EQ. 0) THEN
          IWA(5)=IWA(5)+1
          PLIWA=PLIWA+4
          IF (PLIWA .GT. LIWA) GO TO 9999
          IF (PLIWA-4 .GT. LIVA) THEN
            DO 200 I=PLIWA,LIVA+4+1,-1
              IWA(I)=IWA(I-4)
 200        CONTINUE
          ENDIF
          IF (IWA(5) .GT. 1) THEN
            DO 220 I=4,1,-1
              IWA(LIRC+IWA(5)*I)=IVEK(I)
              DO 210 J=1,IWA(5)-1
                IWA(LIRC+IWA(5)*I-J)=IWA(LIRC+IWA(5)*I-J-(I-1))
 210           CONTINUE
 220         CONTINUE
          ELSE
            DO 230 I=1,4
              IWA(LIRC+I) = IVEK(I)
 230         CONTINUE
          ENDIF
C
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(5))) THEN
          DO 240 I=1,4
            IWA(LIRC+IWA(5)*(I-1)+OFFSET)=IVEK(I)
 240      CONTINUE
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE
        IERR=34
        RETURN
C
C
      ENDIF
C
      INFOLI(1)=15
      INFOLI(2)=IWA(1)*5+INFOLI(1)
      INFOLI(3)=IWA(2)+INFOLI(2)
      INFOLI(4)=IWA(3)*4+INFOLI(3)
      INFOLI(5)=IWA(4)+INFOLI(4)
      INFOLI(7)=IWA(5)*4+INFOLI(5)
      INFOLI(9)=IWA(7)*3+INFOLI(7)
      INFOLI(14)=IWA(9)*7+INFOLI(9)
      INFOLI(15)=IWA(14)+INFOLI(14)
C
      INFOLI(6)=0
      INFOLI(8)=IWA(6)+INFOLI(6)
      INFOLI(11)=IWA(8)+INFOLI(8)
      INFOLI(12)=IWA(11)+INFOLI(11)
      INFOLI(13)=IWA(12)*IWA(8)+INFOLI(12)
C 
      RETURN
C
 9999 CONTINUE
C     WRITE(*,*) 'OUT OF MEMORY'
      IERR=32
      RETURN
      END
C
C
C
      SUBROUTINE PUT5(IVEK,ART,OFFSET,LIWA,PLIWA,IWA,INFOLI,IERR)
C
      INTEGER ART,LIWA,PLIWA,OFFSET
      INTEGER IVEK(5),IWA(LIWA),INFOLI(15),IERR
C
      INTEGER IIS
      INTEGER LIIS,LVIS
      PARAMETER (IIS=1)
C
      INTEGER I,J
C
      LIIS=INFOLI(1)
      LVIS=INFOLI(2)
C
      IF (ART .EQ. IIS) THEN
C
        IF (OFFSET .EQ. 0) THEN
          IWA(1)=IWA(1)+1
          PLIWA=PLIWA+5
          IF (PLIWA .GT. LIWA) GO TO 9999
          IF (PLIWA-5 .GT. LVIS) THEN
            DO 10 I=PLIWA,LVIS+5+1,-1
              IWA(I)=IWA(I-5)
 10         CONTINUE
          ENDIF
          IF (IWA(1) .GT. 1) THEN
            DO 30 I=5,1,-1
              IWA(LIIS+IWA(1)*I)=IVEK(I)
              DO 20 J=1,IWA(1)-1
                IWA(LIIS+IWA(1)*I-J)=IWA(LIIS+IWA(1)*I-J-(I-1))
 20           CONTINUE
 30         CONTINUE
          ELSE
            DO 40 I=1,5
              IWA(LIIS+I) = IVEK(I)
 40         CONTINUE
          ENDIF
C
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(1))) THEN
          DO 140 I=1,5
            IWA(LIIS+IWA(1)*(I-1)+OFFSET)=IVEK(I)
 140      CONTINUE
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE
        IERR=34
        RETURN
C
C
      ENDIF
C
      INFOLI(1)=15
      INFOLI(2)=IWA(1)*5+INFOLI(1)
      INFOLI(3)=IWA(2)+INFOLI(2)
      INFOLI(4)=IWA(3)*4+INFOLI(3)
      INFOLI(5)=IWA(4)+INFOLI(4)
      INFOLI(7)=IWA(5)*4+INFOLI(5)
      INFOLI(9)=IWA(7)*3+INFOLI(7)
      INFOLI(14)=IWA(9)*7+INFOLI(9)
      INFOLI(15)=IWA(14)+INFOLI(14)
C
      INFOLI(6)=0
      INFOLI(8)=IWA(6)+INFOLI(6)
      INFOLI(11)=IWA(8)+INFOLI(8)
      INFOLI(12)=IWA(11)+INFOLI(11)
      INFOLI(13)=IWA(12)*IWA(8)+INFOLI(12)
C 
      RETURN
C
 9999 CONTINUE
C     WRITE(*,*) 'OUT OF MEMORY'
      IERR=32
      RETURN
      END
C
C
C
      SUBROUTINE PUT7(IVEK,ART,OFFSET,LIWA,PLIWA,IWA,INFOLI,IERR)
C
      INTEGER ART,LIWA,PLIWA,OFFSET
      INTEGER IVEK(7),IWA(LIWA),INFOLI(15),IERR
C
      INTEGER IFN
      INTEGER LIFN,LVPF
      PARAMETER (IFN=9)
C
      INTEGER I,J
C
      LIFN=INFOLI(9)
      LVPF=INFOLI(14)
C
      IF (ART .EQ. IFN) THEN
C
        IF (OFFSET .EQ. 0) THEN
          IWA(9)=IWA(9)+1
          PLIWA=PLIWA+7
          IF (PLIWA .GT. LIWA) GO TO 9999
          IF (PLIWA-7 .GT. LVPF) THEN
            DO 100 I=PLIWA,LVPF+7+1,-1
              IWA(I)=IWA(I-7)
 100        CONTINUE
          ENDIF
          IF (IWA(9) .GT. 1) THEN
            DO 120 I=7,1,-1
              IWA(LIFN+IWA(9)*I)=IVEK(I)
              DO 110 J=1,IWA(9)-1
                IWA(LIFN+IWA(9)*I-J)=IWA(LIFN+IWA(9)*I-J-(I-1))
 110           CONTINUE
 120         CONTINUE
          ELSE
            DO 130 I=1,7
              IWA(LIFN+I) = IVEK(I)
 130        CONTINUE
          ENDIF
C
        ELSE IF ((OFFSET .GE. 1) .AND. (OFFSET .LE. IWA(9))) THEN
          DO 140 I=1,7
            IWA(LIFN+IWA(9)*(I-1)+OFFSET)=IVEK(I)
 140      CONTINUE
        ELSE
          IERR=34
          RETURN
        ENDIF    
C
C
      ELSE
        IERR=34
        RETURN
C
C
      ENDIF
C
      INFOLI(1)=15
      INFOLI(2)=IWA(1)*5+INFOLI(1)
      INFOLI(3)=IWA(2)+INFOLI(2)
      INFOLI(4)=IWA(3)*4+INFOLI(3)
      INFOLI(5)=IWA(4)+INFOLI(4)
      INFOLI(7)=IWA(5)*4+INFOLI(5)
      INFOLI(9)=IWA(7)*3+INFOLI(7)
      INFOLI(14)=IWA(9)*7+INFOLI(9)
      INFOLI(15)=IWA(14)+INFOLI(14)
C
      INFOLI(6)=0
      INFOLI(8)=IWA(6)+INFOLI(6)
      INFOLI(11)=IWA(8)+INFOLI(8)
      INFOLI(12)=IWA(11)+INFOLI(11)
      INFOLI(13)=IWA(12)*IWA(8)+INFOLI(12)
C 
      RETURN
C
 9999 CONTINUE
C     WRITE(*,*) 'OUT OF MEMORY'
      IERR=32
      RETURN
      END
C
C
C
      DOUBLE PRECISION FUNCTION GETWA(FELD,DIM,WA,LWA,INFOLI)
C
      INTEGER FELD,DIM
      INTEGER INFOLI(15),LWA
      DOUBLE PRECISION WA(LWA)
C
      INTEGER VRC,VVA,VFN,VGR,VHE
      INTEGER LVRC,LVVA,LVFN,LVGR,LVHE
C
      PARAMETER (VRC=6,VVA=8,VFN=11,VGR=12,VHE=13)
C
      LVRC=INFOLI(6)
      LVVA=INFOLI(8)
      LVFN=INFOLI(11)
      LVGR=INFOLI(12)
      LVHE=INFOLI(13)
C
      IF (FELD .EQ. VRC) THEN
        GETWA=WA(LVRC+DIM)
C
      ELSE IF (FELD .EQ. VVA) THEN
        GETWA=WA(LVVA+DIM)
C
      ELSE IF (FELD .EQ. VFN) THEN
        GETWA=WA(LVFN+DIM)
C
      ELSE IF (FELD .EQ. VGR) THEN
        GETWA=WA(LVGR+DIM)
C    
      ELSE IF (FELD .EQ. VHE) THEN
        GETWA=WA(LVHE+DIM)
C
      ELSE
        STOP 'GETWA: INTERNAL ERROR OF THE DYNAMIC PARSER.'
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE UNVPF(PC,LIWA,PLIWA,IWA,INFOLI)
C
      INTEGER PC,LIWA,PLIWA,IWA(LIWA),INFOLI(15)
C
      INTEGER I
C
      DO 100 I=1,IWA(15)
        IWA(INFOLI(14)+PC+I)=IWA(INFOLI(15)+I)
        IWA(INFOLI(15)+I)=0
 100  CONTINUE
      INFOLI(15)=INFOLI(14)+PC
      IWA(14)=PC
      PLIWA=INFOLI(15)+IWA(15)
      RETURN
      END 
C
C
C
      SUBROUTINE EVALCA(LIWA,IWA,LWA,WA,INFOLI,PC,IVAL,FVAL,IERR)
      INTEGER LWA,LIWA
      INTEGER IWA(LIWA)
      DOUBLE PRECISION WA(LWA)
      INTEGER INFOLI(15)
      INTEGER PC
      DOUBLE PRECISION FVAL
      INTEGER IVAL,IERR
C
      INTEGER MPIIS,MPVIS,MPIIC,MPVIC,MPIRC,MPVRC,MPIVA,MPVVA,MPIFN
      INTEGER MPVFN,MPVPF,MPIV,MPVHE,PVVAHE,MODE
      INTEGER DFVAR(1)
C
      INTEGER NOGRAD
      PARAMETER (NOGRAD=0)
C
        MPIIS=MAX(1,IWA(1))
        MPVIS=MAX(1,IWA(2))
        MPIIC=MAX(1,IWA(3))
        MPVIC=MAX(1,IWA(4))
        MPIRC=MAX(1,IWA(5))
        MPVRC=MAX(1,IWA(6))
        MPIVA=MAX(1,IWA(7))
        MPVVA=MAX(1,IWA(8))
        MPIFN=MAX(1,IWA(9))
        MPVFN=MAX(1,IWA(11))
        MPVPF=MAX(1,IWA(14))
        MPIV =MAX(1,IWA(15))
        MPVHE=1
        PVVAHE=1
        MODE=NOGRAD
        CALL EVAL(PC+1,IVAL,FVAL,MODE,IWA(8),1,MPIIS,MPVIS,MPIIC,
     1            MPVIC,MPIRC,MPVRC,MPIVA,MPVVA,MPIFN,MPVFN,1,MPVPF,
     2            MPIV,IWA(INFOLI(1)+1),IWA(INFOLI(2)+1),
     3            IWA(INFOLI(3)+1),IWA(INFOLI(4)+1),IWA(INFOLI(5)+1),
     4            WA(INFOLI(6)+1),IWA(INFOLI(7)+1),WA(INFOLI(8)+1),
     5            IWA(INFOLI(9)+1),WA(INFOLI(11)+1),WA(INFOLI(12)+1),
     6            WA(INFOLI(13)+1),IWA(INFOLI(14)+1),IWA(INFOLI(15)+1),
     7            WA(INFOLI(13)+MPVHE*PVVAHE*PVVAHE+1),
     8            WA(INFOLI(13)+MPVHE*PVVAHE*PVVAHE+MPVVA*10+1),
     9            DFVAR,0,IERR)
       RETURN
       END
C
C
C
      SUBROUTINE YYPRE (INPUT,OUTPUT,IERR,LNUM)
      PARAMETER (MAXCOLS=128,MAXCOLS1=122)
      INTEGER INPUT,OUTPUT,IERR,LNUM
C
C      CHARACTER STAR*5,CONT*1,LINE*66
      CHARACTER STAR*5,CONT*1,LINE*122
C
      INTEGER MAXMAC
      PARAMETER (MAXMAC=50)
      CHARACTER*20 MNAME(MAXMAC)
      INTEGER MSTART(MAXMAC),MLINES(MAXMAC),MFLAG(MAXMAC)
      INTEGER MCOUNT
C
      INTEGER MAXBUF
      PARAMETER (MAXBUF=1000)
C      CHARACTER*72 EXPAND(MAXBUF),BUFFER(MAXBUF)
      CHARACTER*128 EXPAND(MAXBUF),BUFFER(MAXBUF)
      INTEGER ECOUNT,BCOUNT
C
      CHARACTER*20 KEYWD
      INTEGER POS,LENGTH,I,J,K
C
C   INITIALIZE VARIABLES
C
      MCOUNT=0
      ECOUNT=0
      BCOUNT=0
      IERR=0
      LNUM=0
C
      BUFFER(1)=' '
C
C   READ AND PROCESS ONE LINE FROM INPUT DEVICE
C
   10 READ(INPUT,'(A5,A1,A122)',END=90) STAR,CONT,LINE
      CALL YYFMT(STAR,CONT,LINE)
      LNUM=LNUM+1
   12 IF (STAR(1:1).NE.'*') GOTO 80
      CALL GETID(LINE,1,POS,LENGTH)
      IF ((POS.EQ.0).OR.(LENGTH.GT.20)) GOTO 80
      KEYWD=LINE(POS:POS+LENGTH-1)
      K=POS+LENGTH
C
C   MACRO DEFINITION : READ THE NAME AND INSERT IT INTO THE TABLE
C
      IF ((KEYWD.EQ.'MACRO').OR.(KEYWD.EQ.'macro').OR.
     /       (KEYWD.EQ.'Macro')) THEN
        CALL GETID(LINE,K,POS,LENGTH)
        IF (POS.EQ.0) THEN
          IERR=68
          GOTO 90  
        ENDIF
        MCOUNT=MCOUNT+1
        IF (MCOUNT.GT.MAXMAC) THEN
          IERR=69
          GOTO 90
        ENDIF
        IF (LENGTH.GT.20) LENGTH=20
        MNAME(MCOUNT)=LINE(POS:POS+LENGTH-1)
        MSTART(MCOUNT)=ECOUNT+1
        MLINES(MCOUNT)=0
        MFLAG(MCOUNT)=0
C
C   ... READ THE MACRO EXPANSION (UP TO THE NEXT BLOCK DEFINITION)
C
   20   READ(INPUT,'(A5,A1,A122)',END=90) STAR,CONT,LINE
        CALL YYFMT(STAR,CONT,LINE)
        LNUM=LNUM+1
        IF (STAR(1:1).NE.'*') THEN
          ECOUNT=ECOUNT+1
          IF (ECOUNT.GT.MAXBUF) THEN
            IERR=70
            GOTO 90
          ENDIF
          EXPAND(ECOUNT)=STAR//CONT//LINE        
          MLINES(MCOUNT)=MLINES(MCOUNT)+1
          GOTO 20
        ENDIF
        GOTO 12
C
C   FUNCTION : READ STATEMENTS INTO THE BUFFER
C
      ELSE IF (KEYWD.EQ.'FUNCTION') THEN
        WRITE(OUTPUT,'(3A)') STAR,CONT,LINE
        DO 42 I=1,MCOUNT
          MFLAG(I)=0
   42   CONTINUE
        BCOUNT=0
C
   40   READ(INPUT,'(A5,A1,A122)',END=90) STAR,CONT,LINE
        CALL YYFMT(STAR,CONT,LINE)
        LNUM=LNUM+1
        IF (STAR(1:1).EQ.'C'.OR.LINE.EQ.' ') GOTO 44
C
C   NEXT BLOCK DEFINITION - WRITE STATEMENTS AND USED MACROS TO OUTPUT
C
        IF (STAR(1:1).EQ.'*') THEN
          DO 401 I=1,MCOUNT
          IF (MFLAG(I).NE.0) THEN
            DO 402 J=1,MLINES(I)
              WRITE(OUTPUT,'(A)') EXPAND(MSTART(I)+J-1)
  402       CONTINUE
          MFLAG(I)=0
          ENDIF
  401     CONTINUE
          DO 403 I=1,BCOUNT
            WRITE(OUTPUT,'(A)') BUFFER(I)
  403     CONTINUE
          BCOUNT=0
          GOTO 12
        ENDIF
C
C   SAVE THE CURRENT STATEMENT IN THE BUFFER
C
   44   BCOUNT=BCOUNT+1
        IF (BCOUNT.GT.MAXBUF) THEN
          IERR=71
          GOTO 90
        ENDIF
        BUFFER(BCOUNT)=STAR//CONT//LINE
C
C   LOOK FOR MACROS IN THE CURRENT STATEMENT (SET FLAGS IN THE TABLE)
C
        K=1
   45   CALL GETID(LINE,K,POS,LENGTH)
        IF (POS.GT.0) THEN
          K=POS+LENGTH
          IF (LENGTH.GT.20) LENGTH=20
          DO 47 I=1,MCOUNT
            IF (MNAME(I).EQ.LINE(POS:POS+LENGTH-1)) MFLAG(I)=1
   47     CONTINUE
          GOTO 45
        ENDIF 
        GOTO 40
      ENDIF
C
C   OTHER LINE - JUST PRINT IT
C
   80 WRITE(OUTPUT,'(3A)') STAR,CONT,LINE
      GOTO 10
   90 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE GETID (LINE,START,POS,LENGTH)
      PARAMETER (MAXCOLS=128) 
C      CHARACTER*66 LINE
      CHARACTER*128 LINE
      INTEGER START,POS,LENGTH
C
      CHARACTER C
      INTEGER P,Q
C
      LOGICAL ISALPH,ISDIGI,ISALNU
      ISALPH(C)=((C.GE.'A').AND.(C.LE.'Z').OR.(C.EQ.'_'))
      ISDIGI(C)=((C.GE.'0').AND.(C.LE.'9'))
      ISALNU(C)=(ISALPH(C).OR.ISDIGI(C))
C
C      IF (START.GE.67) THEN
      IF (START.GE.MAXCOLS-5) THEN
        POS=0
        LENGTH=0
        RETURN
      ENDIF
C
      P=START
   10 C=LINE(P:P)
      IF (.NOT.ISALPH(C)) THEN
        P=P+1
C        IF (P.LE.66) GOTO 10
        IF (P.LE.MAXCOLS-6) GOTO 10
      ENDIF
C      IF (P.EQ.67) THEN
      IF (P.EQ.MAXCOLS-5) THEN
        POS=0
        LENGTH=0
        RETURN
      ENDIF
      POS=P
      Q=P
   20 C=LINE(Q:Q)
      IF (ISALNU(C)) THEN
        Q=Q+1
C        IF (Q.LE.66) GOTO 20
        IF (Q.LE.MAXCOLS-6) GOTO 20
      ENDIF
      LENGTH=Q-P
      RETURN
      END
C
C-----------------------------------------------------------------------
C
      SUBROUTINE NEXTID (NOUT)
      INTEGER NOUT
C
      LOGICAL OP
C
      NOUT=10
   10 INQUIRE(NOUT,OPENED=OP)
      IF (OP) THEN
        NOUT=NOUT+1
        GOTO 10
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE YYFMT (STAR,CONT,LINE)
      PARAMETER (MAXCOLS=128,MAXCOLS1=122)
C      CHARACTER STAR*5,CONT*1,LINE*66
      CHARACTER STAR*5,CONT*1,LINE*122
C
C      CHARACTER C, TEMP*72
      CHARACTER C, TEMP*128
      INTEGER I
C
      LOGICAL ISLOWE
      CHARACTER TOUPPE
      ISLOWE(C)=((C.GE.'a').AND.(C.LE.'z'))
      TOUPPE(C)=CHAR(ICHAR(C)+ICHAR('A')-ICHAR('a'))
C
      TEMP(1:5)=STAR
      TEMP(6:6)=CONT
C      TEMP(7:72)=LINE
      TEMP(7:MAXCOLS)=LINE
C
C      DO 10 I=1,72
      DO 10 I=1,MAXCOLS
        C=TEMP(I:I)
        IF (ISLOWE(C)) THEN
          C=TOUPPE(C)
          TEMP(I:I)=C
        ENDIF
   10 CONTINUE
C
      STAR=TEMP(1:5)
      CONT=TEMP(6:6)
C      LINE=TEMP(7:72)
      LINE=TEMP(7:MAXCOLS)
      RETURN
      END

