diff --git a/misc/minicern/src/hbook.f b/misc/minicern/src/hbook.f index 522c731686169..2de5aa981ec20 100644 --- a/misc/minicern/src/hbook.f +++ b/misc/minicern/src/hbook.f @@ -8,27 +8,11 @@ SUBROUTINE HNTVAR2(ID1,IVAR,CHTAG,CHFULL,BLOCK,NSUB,ITYPE,ISIZE + ,NBITS,IELEM) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV + INCLUDE 'param1.inc' + INCLUDE 'hcflag.inc' + INCLUDE 'pawc.inc' COMMON/BIGBUF/BIGB(4000000) character BIGB - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -43,14 +27,7 @@ SUBROUTINE HNTVAR2(ID1,IVAR,CHTAG,CHFULL,BLOCK,NSUB,ITYPE,ISIZE +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, @@ -59,7 +36,7 @@ SUBROUTINE HNTVAR2(ID1,IVAR,CHTAG,CHFULL,BLOCK,NSUB,ITYPE,ISIZE + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230 - CHARACTER*(*) CHTAG, CHFULL, BLOCK + CHARACTER*99 CHTAG, CHFULL, BLOCK CHARACTER*80 VAR CHARACTER*32 NAME, SUBS LOGICAL LDUM @@ -162,12 +139,9 @@ subroutine hntvar3(id,last,chvar) *------------------------------------------------------------------------------- SUBROUTINE HLIMIT (LIMIT) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) - INTEGER IQ ,LQ - REAL Q + INCLUDE 'pawc.inc' + INTEGER IQ,LQ + REAL Q DIMENSION IQ(2),Q(2),LQ(8000) EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1)) INTEGER HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK, @@ -180,14 +154,7 @@ SUBROUTINE HLIMIT (LIMIT) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' COMMON/HCFORM/IODIR,IOH1,IOH2,IOHN,IOCF1,IOCF2,IOCB1,IOCB2, + IOCF4,IOFIT,IONT,IOBL,IOCC PARAMETER (NLPATM=100, MXFILES=50, LENHFN=128) @@ -245,8 +212,8 @@ SUBROUTINE HROPEN(LUN,CHDIR,CFNAME,CHOPTT,LRECL,ISTAT) + ,CHTOP(NLPATM) CHARACTER*(LENHFN) HFNAME COMMON /HCFILE/HFNAME(MXFILES) - COMMON/QUEST/IQUEST(100) CHARACTER*(*) CFNAME,CHDIR,CHOPTT + INCLUDE 'quest.inc' CHARACTER*8 CHOPT CHOPT=CHOPTT CALL CLTOU(CHOPT) @@ -305,6 +272,8 @@ SUBROUTINE HRFILE(LUN,CHDIR,CHOPT) DIMENSION IOPT(6) EQUIVALENCE (IOPTN,IOPT(1)),(IOPTG,IOPT(2)),(IOPTQ,IOPT(3)) EQUIVALENCE (IOPTM,IOPT(4)),(IOPTO,IOPT(5)),(IOPTE,IOPT(6)) + INTEGER NWK + NWK = 0 IF(NCHTOP.GE.MXFILES)THEN print*, 'Too many open files','HRFILE',LUN GO TO 99 @@ -371,7 +340,7 @@ SUBROUTINE HRFILE(LUN,CHDIR,CHOPT) HFNAME(NCHTOP)='Global memory - '//CHDIR ENDIF ENDIF - 10 CHMAIL='//'//CHTOP(NCHTOP) + CHMAIL='//'//CHTOP(NCHTOP) CALL HCDIR(CHMAIL,' ') 99 RETURN END @@ -379,10 +348,7 @@ SUBROUTINE HRFILE(LUN,CHDIR,CHOPT) *------------------------------------------------------------------------------- SUBROUTINE HRIN(IDD,ICYCLE,KOFSET) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -397,14 +363,7 @@ SUBROUTINE HRIN(IDD,ICYCLE,KOFSET) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' PARAMETER (NLPATM=100, MXFILES=50, LENHFN=128) COMMON /HCDIRN/NLCDIR,NLNDIR,NLPAT,ICDIR,NCHTOP,ICHTOP(MXFILES) + ,ICHTYP(MXFILES),ICHLUN(MXFILES) @@ -413,23 +372,10 @@ SUBROUTINE HRIN(IDD,ICYCLE,KOFSET) + ,CHTOP(NLPATM) CHARACTER*(LENHFN) HFNAME COMMON /HCFILE/HFNAME(MXFILES) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param1.inc' COMMON /HNTCUR/ NTCUR - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/QUEST/IQUEST(100) + INCLUDE 'hcflag.inc' + INCLUDE 'quest.inc' CHARACTER*128 CHWOLD INTEGER KEYS(2) DATA KHIDE,KHID1,KHID2,KHCO1,KHCO2/4HHIDE,4HHID1,4HHID2, @@ -612,10 +558,7 @@ SUBROUTINE HRIN(IDD,ICYCLE,KOFSET) *------------------------------------------------------------------------------- SUBROUTINE HRZIN(IXDIV,LBANK,JBIAS,KEYS,ICYCLE,CHOPT) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -630,14 +573,7 @@ SUBROUTINE HRZIN(IXDIV,LBANK,JBIAS,KEYS,ICYCLE,CHOPT) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' PARAMETER (NLPATM=100, MXFILES=50, LENHFN=128) COMMON /HCDIRN/NLCDIR,NLNDIR,NLPAT,ICDIR,NCHTOP,ICHTOP(MXFILES) + ,ICHTYP(MXFILES),ICHLUN(MXFILES) @@ -648,7 +584,7 @@ SUBROUTINE HRZIN(IXDIV,LBANK,JBIAS,KEYS,ICYCLE,CHOPT) COMMON /HCFILE/HFNAME(MXFILES) CHARACTER*128 CHMAIL COMMON /HCMAIL/CHMAIL - COMMON/QUEST/IQUEST(100) + INCLUDE 'quest.inc' DIMENSION LBANK(1),JBIAS(1) INTEGER KEYS(2) CHARACTER*(*)CHOPT @@ -664,10 +600,7 @@ SUBROUTINE HRZIN(IXDIV,LBANK,JBIAS,KEYS,ICYCLE,CHOPT) *------------------------------------------------------------------------------- SUBROUTINE HNOENT(IDD,NUMB) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -682,15 +615,8 @@ SUBROUTINE HNOENT(IDD,NUMB) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'param2.inc' + INCLUDE 'quest.inc' CALL HFIND(IDD,'HNOENT') IF(IQUEST(1).NE.0)THEN NUMB=0 @@ -707,10 +633,7 @@ SUBROUTINE HNOENT(IDD,NUMB) *------------------------------------------------------------------------------- SUBROUTINE HGIVE(IDD,CHTITL,NCX,XMIN,XMAX,NCY,YMIN,YMAX,NWT,IDB) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -725,25 +648,8 @@ SUBROUTINE HGIVE(IDD,CHTITL,NCX,XMIN,XMAX,NCY,YMIN,YMAX,NWT,IDB) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, @@ -752,7 +658,7 @@ SUBROUTINE HGIVE(IDD,CHTITL,NCX,XMIN,XMAX,NCY,YMIN,YMAX,NWT,IDB) + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230 - CHARACTER*(*) CHTITL + CHARACTER*99 CHTITL NARG=10 NCX=0 IF(NARG.GT.5)NCY=0 @@ -794,7 +700,7 @@ SUBROUTINE HGIVE(IDD,CHTITL,NCX,XMIN,XMAX,NCY,YMIN,YMAX,NWT,IDB) IF(NWT.EQ.0)GO TO 99 NCH=LEN(CHTITL) NWCH=MIN(NCH,4*NWT) - IF(NCH.GT.0)CHTITL=' ' + IF (NCH .GT. 0) CHTITL = ' ' CALL UHTOC(IQ(IWT),4,CHTITL,NWCH) 99 RETURN END @@ -802,10 +708,7 @@ SUBROUTINE HGIVE(IDD,CHTITL,NCX,XMIN,XMAX,NCY,YMIN,YMAX,NWT,IDB) *------------------------------------------------------------------------------- SUBROUTINE HGIVEN( ID1, CHTITL, NVAR, TAGS, RLOW, RHIGH ) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -820,29 +723,9 @@ SUBROUTINE HGIVEN( ID1, CHTITL, NVAR, TAGS, RLOW, RHIGH ) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' + INCLUDE 'hcflag.inc' INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, @@ -851,7 +734,7 @@ SUBROUTINE HGIVEN( ID1, CHTITL, NVAR, TAGS, RLOW, RHIGH ) + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230 - CHARACTER*(*) CHTITL, TAGS(*) + CHARACTER*99 CHTITL, TAGS(*) INTEGER ID1, NVAR REAL RLOW(*), RHIGH(*) CHARACTER*8 BLOCK @@ -911,10 +794,7 @@ SUBROUTINE HGIVEN( ID1, CHTITL, NVAR, TAGS, RLOW, RHIGH ) *------------------------------------------------------------------------------- SUBROUTINE HGNPAR(IDN,CHROUT) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -929,14 +809,7 @@ SUBROUTINE HGNPAR(IDN,CHROUT) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' CHARACTER*(*) CHROUT INTEGER KEYS(2) LCIDN=0 @@ -989,10 +862,7 @@ SUBROUTINE HGNPAR(IDN,CHROUT) *------------------------------------------------------------------------------- SUBROUTINE HGNF(IDN,IDNEVT,X,IERROR) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1007,14 +877,7 @@ SUBROUTINE HGNF(IDN,IDNEVT,X,IERROR) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' PARAMETER (NLPATM=100, MXFILES=50, LENHFN=128) COMMON /HCDIRN/NLCDIR,NLNDIR,NLPAT,ICDIR,NCHTOP,ICHTOP(MXFILES) + ,ICHTYP(MXFILES),ICHLUN(MXFILES) @@ -1023,7 +886,7 @@ SUBROUTINE HGNF(IDN,IDNEVT,X,IERROR) + ,CHTOP(NLPATM) CHARACTER*(LENHFN) HFNAME COMMON /HCFILE/HFNAME(MXFILES) - COMMON/QUEST/IQUEST(100) + INCLUDE 'quest.inc' DIMENSION X(*) INTEGER KEYS(2) LC=LQ(LCIDN-1) @@ -1077,10 +940,7 @@ SUBROUTINE HGNT(IDN,IDNEVT,IERROR) *------------------------------------------------------------------------------- SUBROUTINE HGNT1(IDD,BLKNA1,VAR,IOFFST,NVAR,IDNEVT,IERROR) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1095,29 +955,9 @@ SUBROUTINE HGNT1(IDD,BLKNA1,VAR,IOFFST,NVAR,IDNEVT,IERROR) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param2.inc' + INCLUDE 'hcflag.inc' + INCLUDE 'param1.inc' COMMON /HNTCUR/ NTCUR CHARACTER*(*) BLKNA1, VAR(*) CHARACTER*8 BLKNAM, BLKSAV @@ -1184,10 +1024,7 @@ SUBROUTINE HGNT1(IDD,BLKNA1,VAR,IOFFST,NVAR,IDNEVT,IERROR) *------------------------------------------------------------------------------- SUBROUTINE HGNT2(VAR1,IVOFF,NVAR1,IDNEVT,IERROR) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1202,29 +1039,9 @@ SUBROUTINE HGNT2(VAR1,IVOFF,NVAR1,IDNEVT,IERROR) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param2.inc' + INCLUDE 'hcflag.inc' + INCLUDE 'param1.inc' COMMON /HCNT/ IBIPW, IBIPB, IBYPW, ISHBIT LOGICAL NRECOV COMMON /HCRECV/ NRECOV @@ -1234,6 +1051,10 @@ SUBROUTINE HGNT2(VAR1,IVOFF,NVAR1,IDNEVT,IERROR) INTEGER ILOGIC, HNMPTR LOGICAL LOGIC, INDVAR, ALLVAR, USEBUF, CHKOFF EQUIVALENCE (LOGIC, ILOGIC) + INTEGER IOFFST, MXBY1, IOFF + IOFFST = 0 + MXBY1 = 0 + IOFF = 0 IERROR = 0 IERR1 = 0 LNAME = LQ(LBLOK-1) @@ -1547,10 +1368,7 @@ SUBROUTINE HGNT2(VAR1,IVOFF,NVAR1,IDNEVT,IERROR) *------------------------------------------------------------------------------- SUBROUTINE HDCOFL - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1565,14 +1383,7 @@ SUBROUTINE HDCOFL +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, @@ -1596,10 +1407,7 @@ SUBROUTINE HDCOFL *------------------------------------------------------------------------------- SUBROUTINE HDELET(ID1) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1614,29 +1422,9 @@ SUBROUTINE HDELET(ID1) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' + INCLUDE 'hcflag.inc' IF(LCDIR.LE.0)GO TO 999 IF(ID1.EQ.0)GO TO 120 ID=ID1 @@ -1692,10 +1480,7 @@ SUBROUTINE HDELET(ID1) *------------------------------------------------------------------------------- SUBROUTINE HBNAM(IDD, BLKNA1, ADDRES, FORM1, ISCHAR) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1710,31 +1495,11 @@ SUBROUTINE HBNAM(IDD, BLKNA1, ADDRES, FORM1, ISCHAR) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' COMMON/HCFORM/IODIR,IOH1,IOH2,IOHN,IOCF1,IOCF2,IOCB1,IOCB2, + IOCF4,IOFIT,IONT,IOBL,IOCC - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param1.inc' + INCLUDE 'hcflag.inc' INTEGER IDD, ADDRES, HNBPTR CHARACTER*(*) BLKNA1, FORM1 PARAMETER (MAXTOK = 50) @@ -1775,7 +1540,7 @@ SUBROUTINE HBNAM(IDD, BLKNA1, ADDRES, FORM1, ISCHAR) LCHAR = LQ(LCID-2) LINT = LQ(LCID-3) LREAL = LQ(LCID-4) - SFORM = FORM + SFORM = FORM(1:40) CALL CLTOU(SFORM) IF (SFORM(1:6) .EQ. '$CLEAR') THEN CALL HNMSET(IDD, ZNADDR, 0) @@ -1811,10 +1576,7 @@ FUNCTION HI(IDD,I) *------------------------------------------------------------------------------- FUNCTION HIE(IDD,I) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1829,14 +1591,7 @@ FUNCTION HIE(IDD,I) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' CALL HFIND(IDD,'HIE ') IF(JBIT(IQ(LCID+KBITS),9).NE.0)THEN HIE=HCX(I,2) @@ -1863,10 +1618,7 @@ FUNCTION HIJ(IDD,I,J) *------------------------------------------------------------------------------- SUBROUTINE HIX(IDD,I,X) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1881,14 +1633,7 @@ SUBROUTINE HIX(IDD,I,X) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, @@ -1911,10 +1656,7 @@ SUBROUTINE HIX(IDD,I,X) *------------------------------------------------------------------------------- SUBROUTINE HIJXY(IDD,I,J,X,Y) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1929,14 +1671,7 @@ SUBROUTINE HIJXY(IDD,I,J,X,Y) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' CALL HFIND(IDD,'HIJXY ') DX=(Q(LCID+KXMAX)-Q(LCID+KXMIN))/FLOAT(IQ(LCID+KNCX)) DY=(Q(LCID+KYMAX)-Q(LCID+KYMIN))/FLOAT(IQ(LCID+KNCY)) @@ -1954,10 +1689,7 @@ FUNCTION HIJE(IDD,I,J) *------------------------------------------------------------------------------- SUBROUTINE HCDIR(CHPATH,CHOPT) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -1972,14 +1704,7 @@ SUBROUTINE HCDIR(CHPATH,CHOPT) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' PARAMETER (NLPATM=100, MXFILES=50, LENHFN=128) COMMON /HCDIRN/NLCDIR,NLNDIR,NLPAT,ICDIR,NCHTOP,ICHTOP(MXFILES) + ,ICHTYP(MXFILES),ICHLUN(MXFILES) @@ -1988,18 +1713,15 @@ SUBROUTINE HCDIR(CHPATH,CHOPT) + ,CHTOP(NLPATM) CHARACTER*(LENHFN) HFNAME COMMON /HCFILE/HFNAME(MXFILES) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'hcflag.inc' INTEGER LOUT,LERR,LINFIT COMMON/HCUNIT/LOUT,LERR,LINFIT CHARACTER*128 CHMAIL COMMON /HCMAIL/CHMAIL - COMMON/QUEST/IQUEST(100) + INCLUDE 'quest.inc' CHARACTER*2 NODIR PARAMETER (NODIR = '@#') - CHARACTER*128 CHAIN, CACHE + CHARACTER*128 CACHE DIMENSION IOPTV(2),IHDIR(4) EQUIVALENCE (IOPTR,IOPTV(1)), (IOPTP,IOPTV(2)) CHARACTER*(*) CHPATH,CHOPT @@ -2092,10 +1814,7 @@ SUBROUTINE HCDIR(CHPATH,CHOPT) *------------------------------------------------------------------------------- SUBROUTINE HMACHI - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -2110,18 +1829,8 @@ SUBROUTINE HMACHI +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'hcflag.inc' INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, @@ -2216,10 +1925,7 @@ SUBROUTINE HMACHI *------------------------------------------------------------------------------- FUNCTION HCX(ICX,IOPT) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -2234,14 +1940,7 @@ FUNCTION HCX(ICX,IOPT) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' INTEGER IFW ,NW ,NB ,IH ,NHT ,ICN ,IPONCE, + NH ,MSTEP ,NOENT ,NOLD ,IDOLAR,IBLANC,KBINSZ,INO , + KSQUEZ,NCOLMA,NCOLPA,NLINPA, ICBLAC,ICSTAR,ICFUNC, @@ -2328,10 +2027,7 @@ FUNCTION HCX(ICX,IOPT) *------------------------------------------------------------------------------- FUNCTION HCXY(ICX,ICY,IOPT) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -2346,14 +2042,7 @@ FUNCTION HCXY(ICX,ICY,IOPT) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' INTEGER IFW ,NW ,NB ,IH ,NHT ,ICN ,IPONCE, + NH ,MSTEP ,NOENT ,NOLD ,IDOLAR,IBLANC,KBINSZ,INO , + KSQUEZ,NCOLMA,NCOLPA,NLINPA, ICBLAC,ICSTAR,ICFUNC, @@ -2388,10 +2077,7 @@ FUNCTION HCXY(ICX,ICY,IOPT) *------------------------------------------------------------------------------- SUBROUTINE HFIND(IDD,CHROUT) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -2406,18 +2092,8 @@ SUBROUTINE HFIND(IDD,CHROUT) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'hcflag.inc' INTEGER IFW ,NW ,NB ,IH ,NHT ,ICN ,IPONCE, + NH ,MSTEP ,NOENT ,NOLD ,IDOLAR,IBLANC,KBINSZ,INO , + KSQUEZ,NCOLMA,NCOLPA,NLINPA, ICBLAC,ICSTAR,ICFUNC, @@ -2427,7 +2103,7 @@ SUBROUTINE HFIND(IDD,CHROUT) + NH ,MSTEP ,NOENT ,NOLD ,IDOLAR,IBLANC,KBINSZ,INO , + KSQUEZ,NCOLMA,NCOLPA,NLINPA,BIGP ,ICBLAC,ICSTAR,ICFUNC, + IDG ,MAXBIT,IDENT - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' CHARACTER*(*) CHROUT IF(LFIX.NE.0)GO TO 99 IQUEST(1)=0 @@ -2487,10 +2163,7 @@ SUBROUTINE HRZCD(CHDIR,CHOPT) *------------------------------------------------------------------------------- SUBROUTINE HNMADR(VAR1, IADD, ISCHAR) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -2505,26 +2178,9 @@ SUBROUTINE HNMADR(VAR1, IADD, ISCHAR) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' COMMON /HCNT/ IBIPW, IBIPB, IBYPW, ISHBIT - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param1.inc' CHARACTER*(*) VAR1 CHARACTER*32 NAME, VAR INTEGER IADD @@ -2610,7 +2266,7 @@ SUBROUTINE HPATH(CHPATH) CHARACTER*(*) CHPATH CHARACTER*1 CH1,BSLASH CHARACTER*2 CH2 - BSLASH='\\' + BSLASH='\' NCHP=LEN(CHPATH) NLPAT=0 10 IF(CHPATH(NCHP:NCHP).EQ.' ')THEN @@ -2731,10 +2387,7 @@ SUBROUTINE HPATH(CHPATH) *------------------------------------------------------------------------------- SUBROUTINE HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, INDVAR) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -2749,25 +2402,8 @@ SUBROUTINE HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, INDVAR) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' COMMON /HCNT/ IBIPW, IBIPB, IBYPW, ISHBIT LOGICAL INDVAR NSUB = JBYT(IQ(LNAME+IOFF+ZDESC), 18, 3) @@ -2782,10 +2418,7 @@ SUBROUTINE HNDESC(IOFF, NSUB, ITYPE, ISIZE, NBITS, INDVAR) *------------------------------------------------------------------------------- SUBROUTINE HPARNT(IDN, CHROUT) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -2800,25 +2433,8 @@ SUBROUTINE HPARNT(IDN, CHROUT) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' CHARACTER*(*) CHROUT LCID = 0 NIDN = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),IDN) @@ -2853,10 +2469,7 @@ SUBROUTINE HPARNT(IDN, CHROUT) *------------------------------------------------------------------------------- SUBROUTINE HNTMP(IDD) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -2871,29 +2484,9 @@ SUBROUTINE HNTMP(IDD) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param2.inc' + INCLUDE 'hcflag.inc' + INCLUDE 'param1.inc' NDIM = IQ(LCID+ZNDIM) NW = 1 + ZNTMP*NDIM IF (LQ(LCDIR-5) .EQ. 0) THEN @@ -2939,10 +2532,7 @@ SUBROUTINE HNTMP(IDD) *------------------------------------------------------------------------------- SUBROUTINE HNBUFR(IDD) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -2957,30 +2547,10 @@ SUBROUTINE HNBUFR(IDD) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) - COMMON/QUEST/IQUEST(100) + INCLUDE 'param2.inc' + INCLUDE 'hcflag.inc' + INCLUDE 'param1.inc' + INCLUDE 'quest.inc' CHARACTER*128 CHWOLD, CHDIR, CWDRZ INTEGER KEYS(2) LOGICAL MEMORY @@ -3076,10 +2646,7 @@ SUBROUTINE HNBUFR(IDD) *------------------------------------------------------------------------------- SUBROUTINE HNTRD(INDX, IOFF, IBANK, IERROR) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3094,28 +2661,11 @@ SUBROUTINE HNTRD(INDX, IOFF, IBANK, IERROR) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' LOGICAL NRECOV COMMON /HCRECV/ NRECOV - COMMON/QUEST/IQUEST(100) + INCLUDE 'quest.inc' CHARACTER*128 CHWOLD, CHDIR, CWDRZ INTEGER KEYS(2) IF (IQ(LNAME+IOFF+ZIBANK) .EQ. IBANK) THEN @@ -3181,7 +2731,7 @@ SUBROUTINE HNTRD(INDX, IOFF, IBANK, IERROR) LQ(LNAME-INDX) = LR2 RETURN 90 IERROR = 1 -99 END + END *------------------------------------------------------------------------------- @@ -3231,10 +2781,7 @@ SUBROUTINE HRZFRA(IH,IOH,NW) *------------------------------------------------------------------------------- SUBROUTINE HSPACE (N,CHROUT,IDD) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3249,19 +2796,9 @@ SUBROUTINE HSPACE (N,CHROUT,IDD) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/QUEST/IQUEST(100) + + INCLUDE 'hcflag.inc' + INCLUDE 'quest.inc' CHARACTER*(*) CHROUT IDLAST=0 IERR=0 @@ -3279,10 +2816,7 @@ SUBROUTINE HSPACE (N,CHROUT,IDD) *------------------------------------------------------------------------------- SUBROUTINE HNTMPD(IDD) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3297,14 +2831,7 @@ SUBROUTINE HNTMPD(IDD) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + IF (LQ(LCDIR-5) .EQ. 0) RETURN IF (IDD .EQ. 0) THEN CALL MZDROP(IHDIV,LQ(LCDIR-5),'L') @@ -3327,10 +2854,7 @@ SUBROUTINE HNTMPD(IDD) *------------------------------------------------------------------------------- SUBROUTINE HNBUFD(IDD) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3345,14 +2869,7 @@ SUBROUTINE HNBUFD(IDD) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + CALL HNTMPD(IDD) IF (LQ(LCDIR-4) .EQ. 0) RETURN IF (IDD .EQ. 0) THEN @@ -3376,10 +2893,7 @@ SUBROUTINE HNBUFD(IDD) *------------------------------------------------------------------------------- SUBROUTINE HNTVAR(ID1,IVAR,CHTAG,BLOCK,NSUB,ITYPE,ISIZE,IELEM) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3394,29 +2908,9 @@ SUBROUTINE HNTVAR(ID1,IVAR,CHTAG,BLOCK,NSUB,ITYPE,ISIZE,IELEM) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' + INCLUDE 'hcflag.inc' INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, @@ -3496,10 +2990,7 @@ SUBROUTINE HNTVAR(ID1,IVAR,CHTAG,BLOCK,NSUB,ITYPE,ISIZE,IELEM) *------------------------------------------------------------------------------- SUBROUTINE HNMSET(IDD, ITEM, IVAL) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3514,29 +3005,9 @@ SUBROUTINE HNMSET(IDD, ITEM, IVAL) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' + INCLUDE 'hcflag.inc' ID = IDD IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID) IF (IDPOS .LE. 0) THEN @@ -3562,10 +3033,7 @@ SUBROUTINE HNMSET(IDD, ITEM, IVAL) *------------------------------------------------------------------------------- INTEGER FUNCTION HNBPTR(BLKNA1) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3580,25 +3048,8 @@ INTEGER FUNCTION HNBPTR(BLKNA1) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' CHARACTER*(*) BLKNA1 CHARACTER*8 BLKNAM INTEGER IBLKN(2) @@ -3619,10 +3070,7 @@ INTEGER FUNCTION HNBPTR(BLKNA1) *------------------------------------------------------------------------------- SUBROUTINE HNBUFF(IDD, FATAL) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3637,18 +3085,8 @@ SUBROUTINE HNBUFF(IDD, FATAL) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'hcflag.inc' LOGICAL FATAL IF (LQ(LCDIR-4) .EQ. 0) THEN IF (FATAL) THEN @@ -3677,10 +3115,7 @@ SUBROUTINE HNBUFF(IDD, FATAL) *------------------------------------------------------------------------------- SUBROUTINE HNBFWR(IDD) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3695,29 +3130,9 @@ SUBROUTINE HNBFWR(IDD) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' + INCLUDE 'hcflag.inc' CHARACTER*128 CHWOLD, CHDIR, CWDRZ INTEGER KEYS(2) IERR = 0 @@ -3772,10 +3187,7 @@ SUBROUTINE HNBFWR(IDD) *------------------------------------------------------------------------------- SUBROUTINE HNHDWR(IDD) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3790,29 +3202,9 @@ SUBROUTINE HNHDWR(IDD) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'param1.inc' + INCLUDE 'hcflag.inc' CHARACTER*128 CHWOLD, CHDIR, CWDRZ INTEGER KEYS(2) IERR = 0 @@ -3845,10 +3237,7 @@ SUBROUTINE HNHDWR(IDD) *------------------------------------------------------------------------------- SUBROUTINE HLDIR(CHPATH,CHOPT) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3863,14 +3252,7 @@ SUBROUTINE HLDIR(CHPATH,CHOPT) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) + INCLUDE 'param2.inc' INTEGER LOUT,LERR,LINFIT COMMON/HCUNIT/LOUT,LERR,LINFIT PARAMETER (NLPATM=100, MXFILES=50, LENHFN=128) @@ -3885,7 +3267,7 @@ SUBROUTINE HLDIR(CHPATH,CHOPT) COMMON /HCMAIL/CHMAIL DIMENSION IPAWC(99) EQUIVALENCE (NWPAW,IPAWC(1)) - COMMON/QUEST/IQUEST(100) + INCLUDE 'quest.inc' CHARACTER*(*) CHPATH,CHOPT CHARACTER*128 CHWOLD DIMENSION LCUR(15),IOPT(5) @@ -3962,10 +3344,7 @@ SUBROUTINE HLDIR(CHPATH,CHOPT) *------------------------------------------------------------------------------- SUBROUTINE HLDIRT(CHDIR) - INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN - REAL FENC , HCV - COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN, - +HCV(4000000-11) + INCLUDE 'pawc.inc' INTEGER IQ ,LQ REAL Q DIMENSION IQ(2),Q(2),LQ(8000) @@ -3980,33 +3359,13 @@ SUBROUTINE HLDIRT(CHDIR) +LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT, +LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN - INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, - + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, - + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , - + KCON1 ,KCON2 ,KBITS ,KNTOT - PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, - + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, - + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, - + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) - INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV - COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, - + NCHAR ,NRHIST,IERR ,NV + INCLUDE 'param2.inc' + INCLUDE 'hcflag.inc' INTEGER LOUT,LERR,LINFIT COMMON/HCUNIT/LOUT,LERR,LINFIT - INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, - + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, - + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, - + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, - + ZID, ZNTMP, ZNTMP1, ZLINK - PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, - + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, - + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, - + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, - + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, - + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) + INCLUDE 'param1.inc' CHARACTER*(*) CHDIR - COMMON/QUEST/IQUEST(100) + INCLUDE 'quest.inc' CHARACTER*1 HTYPE INTEGER KEYS(2) NCH=LENOCC(CHDIR) diff --git a/misc/minicern/src/hcflag.inc b/misc/minicern/src/hcflag.inc new file mode 100644 index 0000000000000..cb9e7324076e5 --- /dev/null +++ b/misc/minicern/src/hcflag.inc @@ -0,0 +1,5 @@ +C=== hcflag.inc ================================================ + INTEGER ID,IDBADD,LID,IDLAST,IDHOLD,NBIT,NBITCH, + + NCHAR,NRHIST,IERR,NV + COMMON /HCFLAG/ ID,IDBADD,LID,IDLAST,IDHOLD,NBIT,NBITCH, + + NCHAR,NRHIST,IERR ,NV diff --git a/misc/minicern/src/kernlib.f b/misc/minicern/src/kernlib.f index 701f776e015f9..654bb1ac87e2b 100644 --- a/misc/minicern/src/kernlib.f +++ b/misc/minicern/src/kernlib.f @@ -195,8 +195,8 @@ SUBROUTINE SBIT0 (IZW,IZP) *------------------------------------------------------------------------------- SUBROUTINE UCTOH (MS,MT,NPW,NCH) - CHARACTER MS*99 - DIMENSION MT(99) + CHARACTER MS*(*) + DIMENSION MT(NPW) PARAMETER (NBITPW=32) PARAMETER (NCHAPW=4) CHARACTER CHWORD*(NCHAPW) @@ -244,7 +244,7 @@ SUBROUTINE UCTOH (MS,MT,NPW,NCH) SUBROUTINE UHTOC (MS,NPW,MT,NCH) DIMENSION MS(99) - CHARACTER MT*99 + CHARACTER MT*128 PARAMETER (NCHAPW=4) CHARACTER CHWORD*(NCHAPW) INTEGER IWORD @@ -310,14 +310,15 @@ SUBROUTINE UCTOH1 (MS,MT,NCH) SUBROUTINE UCOPYI (IA,IB,N) DIMENSION IA(*),IB(*) IF (N.EQ.0) RETURN - DO 21 I=1,N - 21 IB(I)=IA(I) + DO 21 I=1,N + 21 IB(I) = IA(I) END + SUBROUTINE UCOPY (A,B,N) DIMENSION A(*),B(*) IF (N.EQ.0) RETURN - DO 21 I=1,N - 21 B(I)=A(I) + DO 21 I=1,N + 21 B(I) = A(I) END *------------------------------------------------------------------------------- diff --git a/misc/minicern/src/param1.inc b/misc/minicern/src/param1.inc new file mode 100644 index 0000000000000..05f1caf2a86f2 --- /dev/null +++ b/misc/minicern/src/param1.inc @@ -0,0 +1,12 @@ +C=== param1.inc ================================================ + INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, + + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, + + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, + + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, + + ZID, ZNTMP, ZNTMP1, ZLINK + PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, + + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, + + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, + + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, + + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, + + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) diff --git a/misc/minicern/src/param2.inc b/misc/minicern/src/param2.inc new file mode 100644 index 0000000000000..efe95f372a6a5 --- /dev/null +++ b/misc/minicern/src/param2.inc @@ -0,0 +1,9 @@ +C=== param2.inc ================================================ + INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, + + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, + + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , + + KCON1 ,KCON2 ,KBITS ,KNTOT + PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, + + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, + + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, + + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) diff --git a/misc/minicern/src/pawc.inc b/misc/minicern/src/pawc.inc new file mode 100644 index 0000000000000..2bb8b5bb1d45b --- /dev/null +++ b/misc/minicern/src/pawc.inc @@ -0,0 +1,4 @@ +C=== pawc.inc ================================================== + INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,IFENCE,LMAIN,IPAW + COMMON /PAWC/ NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,IFENCE(5),LMAIN, + + IPAW(4000000-11) diff --git a/misc/minicern/src/quest.inc b/misc/minicern/src/quest.inc new file mode 100644 index 0000000000000..cd634e7cc2deb --- /dev/null +++ b/misc/minicern/src/quest.inc @@ -0,0 +1,3 @@ +C=== quest.inc ================================================= + INTEGER IQUEST + COMMON /QUEST/ IQUEST(100) diff --git a/misc/minicern/src/zebra.f b/misc/minicern/src/zebra.f index 80477ee9bfa50..f145de3c9817a 100644 --- a/misc/minicern/src/zebra.f +++ b/misc/minicern/src/zebra.f @@ -31,7 +31,7 @@ SUBROUTINE MZEBRA (LIST) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -57,7 +57,6 @@ SUBROUTINE MZEBRA (LIST) COMMON/RZCSTRC/RZNAMES,RZSFILE COMMON/RZCSTRI/ISLAST,ISTRIP(MAXFILES),NSTRIP(MAXFILES), + NRSTRIP(MAXFILES) - CHARACTER*4 CVERSN DIMENSION LIST(9), INKEYS(3) DATA INKEYS / 4HEBRA, 4HINIT, 4HDONE / 12 NQSTOR = -1 @@ -105,7 +104,7 @@ SUBROUTINE MZINCO (LIST) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' DIMENSION LIST(9) JBIT(IZW,IZP) = IAND(ISHFT(IZW,-(IZP-1)),1) CALL VZEROI (IQUEST,100) @@ -202,8 +201,7 @@ SUBROUTINE MZINCO (LIST) *------------------------------------------------------------------------------- SUBROUTINE MZPAW (NWORDS,CHOPT) - COMMON /PAWC/ NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKU,IFENCE(5) - +, LMAIN, IPAW(4000000-11) + INCLUDE 'pawc.inc' CHARACTER *(*) CHOPT CALL UOPTC (CHOPT,'M',IPAW) IF (IPAW(1).NE.0) CALL MZEBRA(-1) @@ -211,7 +209,7 @@ SUBROUTINE MZPAW (NWORDS,CHOPT) CALL MZSTOR (IXPAWC,'/PAWC/',' ',IFENCE,LMAIN,IPAW(1),IPAW(1), + IPAW(5000),IPAW(NW-11)) NWPAW = NW - IHBOOK = 0 + IHDIV = 0 IXHIGZ = 0 IXKU = 0 END @@ -235,7 +233,7 @@ SUBROUTINE MZSTOR (IXSTOR,CHNAME,CHOPT COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -463,16 +461,15 @@ SUBROUTINE RZOPEN(LUNIN,CHDIR,CFNAME,CHOPTT,LRECL,ISTAT) COMMON/RZCKEY/IHEAD(3),KEY(100),KEY2(100),KEYDUM(50) COMMON /RZCLUN/LUN,LREC,ISAVE,IMODEX,IRELAT,NHPWD,IHPWD(2) +, IZRECL,IMODEC,IMODEH - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /RZBUFF/ ITEST(8704) PARAMETER (MAXFILES=128, MAXSTRIP=21) CHARACTER*128 RZNAMES(MAXFILES),RZSFILE(MAXSTRIP) COMMON/RZCSTRC/RZNAMES,RZSFILE COMMON/RZCSTRI/ISLAST,ISTRIP(MAXFILES),NSTRIP(MAXFILES), + NRSTRIP(MAXFILES) - integer cfstat,statf,info(12) + integer cfstat,info(12) CHARACTER*(*) CFNAME,CHDIR,CHOPTT - CHARACTER*9 SPACES CHARACTER*8 STAT CHARACTER*36 CHOPT CHARACTER*255 CHFILE @@ -700,7 +697,7 @@ SUBROUTINE RZIODO(LUNRZ,JREC,IREC1,IBUF,IRW) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -803,7 +800,7 @@ SUBROUTINE RZIODO(LUNRZ,JREC,IREC1,IBUF,IRW) SUBROUTINE RZVCYC(LTAD) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -871,7 +868,7 @@ SUBROUTINE RZVCYC(LTAD) SUBROUTINE RZIN(IXDIV,LSUP,JBIAS,KEYU,ICYCLE,CHOPT) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -968,7 +965,7 @@ SUBROUTINE RZINS(IXDIVP,LSUPP,JBIASP,LBANK) COMMON /ZMACH/ NQBITW,NQBITC,NQCHAW +, NQLNOR,NQLMAX,NQLPTH,NQRMAX,IQLPCT,IQNIL PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -1017,7 +1014,7 @@ SUBROUTINE RZINS(IXDIVP,LSUPP,JBIASP,LBANK) COMMON /FZCOCC/NQOCC,IQOCDV(20),IQOCSP(20) COMMON /RZCLUN/LUN,LREC,ISAVE,IMODEX,IRELAT,NHPWD,IHPWD(2) +, IZRECL,IMODEC,IMODEH - DIMENSION IXDIVP(9),LSUPP(9),JBIASP(9),IDUM(3) + DIMENSION IXDIVP(9),LSUPP(9),JBIASP(9) EQUIVALENCE (IOPTR,IQUEST(95)) JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) IXDIVI = IXDIVP(1) @@ -1144,17 +1141,16 @@ SUBROUTINE ZITOH (INTV,IHOLL,NP) +, IQCROP,IQVERT,IQCRCL,IQNOT, IQGRAV, IQILEG +, NQHOL0,NQHOLL(95) COMMON /SLATE/ DUMMY(8), MM(4), DUMB(28) - DIMENSION INTV(99), IHOLL(99), NP(9) + DIMENSION INTV(NP), IHOLL(NP) DIMENSION MPAK(2) DATA MPAK /6,4/ - N = NP(1) - DO 39 JW=1,N - CALL UPKBYT (INTV(JW),1,MM(1),4,MPAK(1)) - DO 16 J=1,4 - JV = MM(J) - IF (JV.EQ.0) JV=45 - 16 MM(J) = IQLETT(JV) - CALL UBUNCH (MM(1),IHOLL(JW),4) + DO 39 JW=1,NP + CALL UPKBYT (INTV(JW),1,MM(1),4,MPAK(1)) + DO 16 J=1,4 + JV = MM(J) + IF (JV.EQ.0) JV=45 + 16 MM(J) = IQLETT(JV) + CALL UBUNCH (MM(1),IHOLL(JW),4) 39 CONTINUE END @@ -1162,7 +1158,7 @@ SUBROUTINE ZITOH (INTV,IHOLL,NP) SUBROUTINE MZRESV PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -1243,7 +1239,7 @@ SUBROUTINE MZRESV SUBROUTINE RZSAVE PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -1278,7 +1274,10 @@ SUBROUTINE RZSAVE + KIROUT=18,KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24, + KLB=25,KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31, + KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100) + INTEGER ITIME, IDATE JBIT(IZW,IZP) = IAND(ISHFT(IZW,-(IZP-1)),1) + ITIME = 0 + IDATE = 0 IF(LQRS.EQ.0)GO TO 99 IF(LTOP.EQ.0)GO TO 99 IF(JBIT(IQ(KQSP+LTOP),2).NE.0)THEN @@ -1370,7 +1369,7 @@ SUBROUTINE RZSAVE *------------------------------------------------------------------------------- SUBROUTINE FZICV (MS,IRMT) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /MZIOC/ NWFOAV,NWFOTT,NWFODN,NWFORE,IFOCON(3) +, MFOSAV(2), JFOEND,JFOREP,JFOCUR,MFO(200) DIMENSION MS(99), IRMT(99) @@ -1485,7 +1484,7 @@ SUBROUTINE FZIREL COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -1618,7 +1617,7 @@ SUBROUTINE FZIREL SUBROUTINE FZILIN PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -1686,7 +1685,7 @@ SUBROUTINE MZCHLS (IXST,LP) COMMON /ZMACH/ NQBITW,NQBITC,NQCHAW +, NQLNOR,NQLMAX,NQLPTH,NQRMAX,IQLPCT,IQNIL PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -1712,10 +1711,9 @@ SUBROUTINE MZCHLS (IXST,LP) DIMENSION IQTABV(16) EQUIVALENCE (IQTABV(1),LQPSTO) COMMON /MZCN/ IQLN,IQLS,IQNIO,IQID,IQNL,IQNS,IQND, IQNX,IQFOUL - DIMENSION IXST(9), LP(9) JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) - IXSTOR = IXST(1) - IQLS = LP(1) + IXSTOR = IXST + IQLS = LP IF (IXSTOR.EQ.-7) GO TO 21 IF (JBYT(IXSTOR,27,6).NE.JQSTOR) CALL MZSDIV (IXSTOR,-7) 21 IF (IQLS.LT.LQSTA(KQT+1)) GO TO 98 @@ -1744,7 +1742,7 @@ SUBROUTINE MZCHLS (IXST,LP) *------------------------------------------------------------------------------- - SUBROUTINE MZBOOK (IXP,LP,LSUPP,JBP, CHIDH,NL,NS,ND,NIOP,NZP) + SUBROUTINE MZBOOK (IXP,LP,LSUPP,JBP,CHIDH,NL,NS,ND,NIOP,NZP) COMMON /ZBCD/ IQNUM2(11),IQLETT(26),IQNUM(10), IQPLUS,IQMINS +, IQSTAR,IQSLAS,IQOPEN,IQCLOS,IQDOLL,IQEQU, IQBLAN +, IQCOMA,IQDOT, IQNUMB,IQAPO, IQEXCL,IQCOLO,IQQUOT @@ -1753,7 +1751,7 @@ SUBROUTINE MZBOOK (IXP,LP,LSUPP,JBP, CHIDH,NL,NS,ND,NIOP,NZP) +, IQCROP,IQVERT,IQCRCL,IQNOT, IQGRAV, IQILEG +, NQHOL0,NQHOLL(95) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -1780,9 +1778,8 @@ SUBROUTINE MZBOOK (IXP,LP,LSUPP,JBP, CHIDH,NL,NS,ND,NIOP,NZP) EQUIVALENCE (IQTABV(1),LQPSTO) COMMON /MZCL/ NQLN,NQLS,NQNIO,NQID,NQNL,NQNS,NQND,NQIOCH(16) +, LQSUP,NQBIA, NQIOSV(3) - DIMENSION IXP(9),LP(9),LSUPP(9),JBP(9),NIOP(9),NZP(9) CHARACTER CHIDH*(*) - DIMENSION NAMESR(2) + DIMENSION NAMESR(2),NAME(5) DATA NAMESR / 4HMZBO, 4HOK / JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) MQTRAC(NQTRAC+1) = NAMESR(1) @@ -1790,12 +1787,13 @@ SUBROUTINE MZBOOK (IXP,LP,LSUPP,JBP, CHIDH,NL,NS,ND,NIOP,NZP) NQTRAC = NQTRAC + 2 NQID = IQQUES NIO = MIN (4, LEN(CHIDH)) - IF (NIO.NE.0) CALL UCTOH (CHIDH,NQID,4,NIO) + NAME(1) = NQID + IF (NIO.NE.0) CALL UCTOH (CHIDH,NAME,4,NIO) NQNL = NL NQNS = NS NQND = ND - NQBIA = JBP(1) - IODORG = NIOP(1) + NQBIA = JBP + IODORG = NIOP NIO = JBYT (IODORG,12,4) IF (NIO.EQ.0) THEN NQIOCH(1) = IODORG @@ -1803,8 +1801,8 @@ SUBROUTINE MZBOOK (IXP,LP,LSUPP,JBP, CHIDH,NL,NS,ND,NIOP,NZP) CALL UCOPYI (NIOP,NQIOCH,NIO+1) NQIOSV(1) = 0 ENDIF - CALL MZLIFT (IXP,LP,LSUPP,63, NQID, NZP) - 999 NQTRAC = NQTRAC - 2 + CALL MZLIFT (IXP,LP,LSUPP,63, NAME, NZP) + NQTRAC = NQTRAC - 2 END *------------------------------------------------------------------------------- @@ -1819,7 +1817,7 @@ SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO) COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -1856,8 +1854,8 @@ SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO) +, LQTA,LQTE, LQRTA,LQTC1,LQTC2,LQRTE +, LQMTA,LQMTB,LQMTE,LQMTLU,LQMTBR +, LQMTC1,LQMTC2, NQFRTC,NQLIVE - DIMENSION IXDIV(9), LP(9), LSUPP(9), NAME(9) - DIMENSION NAMESR(2) + DIMENSION NAME(5) + DIMENSION NAMESR(2) DATA NAMESR / 4HMZLI, 4HFT / JBIT(IZW,IZP) = IAND(ISHFT(IZW,-(IZP-1)),1) JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) @@ -1874,8 +1872,8 @@ SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO) CALL UCOPYI (NAME,NQID,NIO+5) IF (NIO.NE.0) NQIOSV(1)=0 ENDIF - JDV = IXDIV(1) - LQSUP = LSUPP(1) + JDV = IXDIV + LQSUP = LSUPP IF (NQBIA.GE.2) LQSUP = 0 ICHORG = NQIOCH(1) NTOT = NQNL + NQND + 10 @@ -2039,7 +2037,7 @@ SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO) 73 LNEXT = LQSUP IF (LNEXT.NE.0) GO TO 74 LUP = 0 - KADR = LOCF (LSUPP(1)) - LQSTOR + KADR = LOCF (LSUPP) - LQSTOR IF (KADR.LT.LQSTA(KQT+1)) GO TO 78 IF (KADR.LT.LQSTA(KQT+21)) GO TO 98 GO TO 78 @@ -2051,7 +2049,7 @@ SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO) 78 LQ(KQS+NQLS+1) = LUP LQ(KQS+NQLS+2) = KADR LQ(KQS+KADR) = NQLS - 79 LP(1) = NQLS + 79 LP = NQLS IF (NQLOGL.GE.2) + WRITE (IQLOG,9079) JQSTOR,JQDIVI,NQLS,LQSUP,NQBIA, + NQID,NQNL,NQNS,NQND @@ -2063,10 +2061,10 @@ SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO) CALL MZGAR1 LQSUP = LQMST(KQT+1) IF (NQBIA.GE.1) GO TO 61 - KADR = LOCF (LSUPP(1)) - LQSTOR + KADR = LOCF (LSUPP) - LQSTOR IF (KADR.LT.LQSTA(KQT+1)) GO TO 83 IF (KADR.LT.LQSTA(KQT+21)) GO TO 61 - 83 LSUPP(1) = LQSUP + 83 LSUPP = LQSUP GO TO 61 98 NQCASE = 8 NQFATA = 1 @@ -2093,8 +2091,8 @@ SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO) IQUEST(15) = NQNS IQUEST(16) = NQND IQUEST(17) = ICHORG - IQUEST(9) = NAMESR(1) - IQUEST(10)= NAMESR(2) + IQUEST( 9) = NAMESR(1) + IQUEST(10) = NAMESR(2) END *------------------------------------------------------------------------------- @@ -2113,7 +2111,7 @@ SUBROUTINE MZLINK (IXSTOR,CHNAME,LAREA,LREF,LREFL) COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -2138,7 +2136,7 @@ SUBROUTINE MZLINK (IXSTOR,CHNAME,LAREA,LREF,LREFL) +, IQDN1(20), IQDN2(20), KQFT, LQFSTA(21) DIMENSION IQTABV(16) EQUIVALENCE (IQTABV(1),LQPSTO) - DIMENSION LAREA(9),LREF(9),LREFL(9),NAME(2) + DIMENSION NAME(2) CHARACTER *(*) CHNAME DIMENSION NAMESR(2) DATA NAMESR / 4HMZLI, 4HNK / @@ -2156,9 +2154,9 @@ SUBROUTINE MZLINK (IXSTOR,CHNAME,LAREA,LREF,LREFL) LQSYSS(KQT+1) = LSYS ENDIF LSTO = LSYS + NWTAB - LOCAR = LOCF (LAREA(1)) - LQSTOR - LOCR = LOCF (LREF(1)) - LQSTOR - LOCRL = LOCF (LREFL(1)) - LQSTOR + LOCAR = LOCF (LAREA) - LQSTOR + LOCR = LOCF (LREF) - LQSTOR + LOCRL = LOCF (LREFL) - LQSTOR NS = LOCR - LOCAR NL = LOCRL+1 - LOCAR IF (NL.EQ.1) THEN @@ -2206,9 +2204,9 @@ SUBROUTINE MZLINK (IXSTOR,CHNAME,LAREA,LREF,LREFL) IF (KLE.GT.JLA .AND. KLA.LT.JLE) GO TO 94 44 CONTINUE 47 CONTINUE - 61 IQ(KQS+LSYS+1) = NWTAB + 5 + IQ(KQS+LSYS+1) = NWTAB + 5 CALL VZEROI (LAREA,NL) - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 RETURN 94 NQCASE = 1 NQFATA = 3 @@ -2250,7 +2248,7 @@ SUBROUTINE MZPUSH (IXDIV,LORGP,INCNLP,INCNDP,CHOPT) COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -2284,9 +2282,8 @@ SUBROUTINE MZPUSH (IXDIV,LORGP,INCNLP,INCNDP,CHOPT) +, LQTA,LQTE, LQRTA,LQTC1,LQTC2,LQRTE +, LQMTA,LQMTB,LQMTE,LQMTLU,LQMTBR +, LQMTC1,LQMTC2, NQFRTC,NQLIVE - DIMENSION IXDIV(9),LORGP(9),INCNLP(9),INCNDP(9) CHARACTER *(*) CHOPT - DIMENSION NAMESR(2) + DIMENSION NAMESR(2), NAME(5) DATA NAMESR / 4HMZPU, 4HSH / JBIT(IZW,IZP) = IAND(ISHFT(IZW,-(IZP-1)),1) MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1)) @@ -2296,12 +2293,12 @@ SUBROUTINE MZPUSH (IXDIV,LORGP,INCNLP,INCNDP,CHOPT) MQTRAC(NQTRAC+1) = NAMESR(1) MQTRAC(NQTRAC+2) = NAMESR(2) NQTRAC = NQTRAC + 2 - IF (IXDIV(1).EQ.-7) GO TO 12 + IF (IXDIV.EQ.-7) GO TO 12 CALL MZSDIV (IXDIV,0) 12 CALL MZCHNB (LORGP) - LORG = LORGP(1) - INCNL = INCNLP(1) - INCND = INCNDP(1) + LORG = LORGP + INCNL = INCNLP + INCND = INCNDP CALL UOPTC (CHOPT,'RI',IQUEST) IFLAG = MIN (2, IQUEST(1)+2*IQUEST(2)) IF ((INCNL.EQ.0) .AND. (INCND.EQ.0)) GO TO 999 @@ -2436,7 +2433,8 @@ SUBROUTINE MZPUSH (IXDIV,LORGP,INCNLP,INCNDP,CHOPT) 56 J = 64*(32*NQNIO + NQNIO + 1) + 1 NQIOCH(1) = MSBYT (J,NQIOCH(1),1,16) NQBIA = 2 - CALL MZLIFT (-7,LNEW,0,63,NQID,-1) + NAME(1) = NQID + CALL MZLIFT (-7,LNEW,0,63,NAME,-1) LORG = LQSYSR(KQT+1) NDELTA = LNEW - LORG CALL UCOPYI (LQ(KQS+LORG-NLC),LQ(KQS+LNEW-NLC),NLC+4) @@ -2493,7 +2491,7 @@ SUBROUTINE MZPUSH (IXDIV,LORGP,INCNLP,INCNDP,CHOPT) LQTE = LQTA + 4 CALL MZRELX NQDPSH(KQT+JQDIVI) = NQDPSH(KQT+JQDIVI) + 1 - 81 LORGP(1) = LNEW + 81 LORGP = LNEW IF (INCND.GT.0) CALL VZEROI (IQ(KQS+LNEW+ND+1),INCND) 999 NQTRAC = NQTRAC - 2 RETURN @@ -2529,7 +2527,7 @@ SUBROUTINE MZNEED (IXDIV,NEEDP,CHOPT) COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -2586,7 +2584,7 @@ SUBROUTINE MZNEED (IXDIV,NEEDP,CHOPT) + WRITE (IQLOG,9029) JQSTOR,JQDIVI,NEED,NQRESV,CHOPT 9029 FORMAT (' MZNEED- Store/Div',2I3,' NEED/Excess=',2I8 F,' Opt=',A) - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 RETURN 41 CALL UOPTC (CHOPT,'G',IQUEST) IF (IQUEST(1).EQ.0) GO TO 28 @@ -2642,7 +2640,7 @@ SUBROUTINE RZCDIR(CHPATH,CHOPT) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -2801,7 +2799,7 @@ SUBROUTINE RZFILE(LUNIN,CHDIR,CHOPT) COMMON /ZSTATE/QVERSN,NQPHAS,IQDBUG,NQDCUT,NQWCUT,NQERR +, NQLOGD,NQLOGM,NQLOCK,NQDEVZ,NQOPTS(6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -3031,7 +3029,7 @@ SUBROUTINE RZFDIR(CHROUT,LT,LDIR,CHOPT) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -3081,9 +3079,11 @@ SUBROUTINE RZFDIR(CHROUT,LT,LDIR,CHOPT) DIMENSION IHDIR(4) LOGICAL RZSAME INTEGER FQUOTA + INTEGER LOGLV JBIT(IZW,IZP) = IAND(ISHFT(IZW,-(IZP-1)),1) JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) IOPTQ = INDEX(CHOPT,'Q') + LOGLV=0 LT=0 LDIR=0 IF(LQRS.EQ.0) GOTO 110 @@ -3158,7 +3158,7 @@ SUBROUTINE RZFDIR(CHROUT,LT,LDIR,CHOPT) 30 CONTINUE ENDIF ELSE - 40 IF(RZSAME(IHDIR,IQ(KQSP+LRN+1),4))THEN + IF(RZSAME(IHDIR,IQ(KQSP+LRN+1),4))THEN LRZ = LRN LDIR= LRN GOTO 60 @@ -3213,7 +3213,7 @@ SUBROUTINE FZIMTB COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -3508,7 +3508,7 @@ FUNCTION IUCOMP (ITEXT,IVECT,N) *------------------------------------------------------------------------------- SUBROUTINE IZBCDT (NP,ITABT) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' PARAMETER (NQTCET=256) COMMON /ZCETA/ IQCETA(256),IQTCET(256) COMMON /ZKRAKC/IQHOLK(120), IQKRAK(80), IQCETK(122) @@ -3550,7 +3550,7 @@ LOGICAL FUNCTION RZSAME(IH1,IH2,N) SUBROUTINE RZINK(KEYU,ICYCLE,CHOPT) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -3772,7 +3772,7 @@ SUBROUTINE RZPAFF(CH,NL,CHPATH) CHARACTER*(*) CHPATH,CH(*) CHARACTER*255 CHTEMP CHARACTER*16 CHL - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' MAXLEN=LEN(CHPATH) IF(MAXLEN.GT.255)MAXLEN=255 IQUEST(1) = 0 @@ -3951,7 +3951,7 @@ SUBROUTINE RZREAD(IV,N,IPC,IFORM) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -3990,6 +3990,8 @@ SUBROUTINE RZREAD(IV,N,IPC,IFORM) COMMON /MZIOC/ NWFOAV,NWFOTT,NWFODN,NWFORE,IFOCON(3) +, MFOSAV(2), JFOEND,JFOREP,JFOCUR,MFO(200) DIMENSION IV(*) + INTEGER IDOUB1 + IDOUB1 = 0 NL1=LREC-IP1+1 IF(IPC.LE.NL1)THEN IRS=IR1 @@ -4154,7 +4156,7 @@ SUBROUTINE MZCHLN (IXST,LP) COMMON /ZMACH/ NQBITW,NQBITC,NQCHAW +, NQLNOR,NQLMAX,NQLPTH,NQRMAX,IQLPCT,IQNIL PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -4180,10 +4182,9 @@ SUBROUTINE MZCHLN (IXST,LP) DIMENSION IQTABV(16) EQUIVALENCE (IQTABV(1),LQPSTO) COMMON /MZCN/ IQLN,IQLS,IQNIO,IQID,IQNL,IQNS,IQND, IQNX,IQFOUL - DIMENSION IXST(9), LP(9) JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) - IXSTOR = IXST(1) - IQLN = LP(1) + IXSTOR = IXST + IQLN = LP IF (IXSTOR.EQ.-7) GO TO 21 IF (JBYT(IXSTOR,27,6).NE.JQSTOR) CALL MZSDIV (IXSTOR,-7) 21 IF (IQLN.LT.LQSTA(KQT+1)) GO TO 98 @@ -4226,7 +4227,7 @@ SUBROUTINE MZCHLN (IXST,LP) SUBROUTINE MZCHNB (LIX) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -4277,7 +4278,7 @@ SUBROUTINE MZDROP (IXSTOR,LHEADP,CHOPT) COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -4303,12 +4304,11 @@ SUBROUTINE MZDROP (IXSTOR,LHEADP,CHOPT) DIMENSION IQTABV(16) EQUIVALENCE (IQTABV(1),LQPSTO) COMMON /MZCN/ IQLN,IQLS,IQNIO,IQID,IQNL,IQNS,IQND, IQNX,IQFOUL - DIMENSION LHEADP(9) CHARACTER *(*) CHOPT DIMENSION NAMESR(2) DATA NAMESR / 4HMZDR, 4HOP / JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) - LHEAD = LHEADP(1) + LHEAD = LHEADP IF (LHEAD.EQ.0) RETURN MQTRAC(NQTRAC+1) = NAMESR(1) MQTRAC(NQTRAC+2) = NAMESR(2) @@ -4359,7 +4359,7 @@ FUNCTION MZDVAC (IXDIVP) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -4419,7 +4419,7 @@ FUNCTION MZDVAC (IXDIVP) 47 JDIV = JDIV + 1 IF (JDIV.LT.21) GO TO 42 59 MZDVAC = IXAC - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 END *------------------------------------------------------------------------------- @@ -4431,7 +4431,7 @@ SUBROUTINE MZGARB (IXGP,IXWP) COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -4462,11 +4462,10 @@ SUBROUTINE MZGARB (IXGP,IXWP) +, LQTA,LQTE, LQRTA,LQTC1,LQTC2,LQRTE +, LQMTA,LQMTB,LQMTE,LQMTLU,LQMTBR +, LQMTC1,LQMTC2, NQFRTC,NQLIVE - DIMENSION IXGP(1), IXWP(9) DIMENSION NAMESR(2) DATA NAMESR / 4HMZGA, 4HRB / - IXGARB = IXGP(1) - IXWIPE = IXWP(1) + IXGARB = IXGP + IXWIPE = IXWP MQTRAC(NQTRAC+1) = NAMESR(1) MQTRAC(NQTRAC+2) = NAMESR(2) NQTRAC = NQTRAC + 2 @@ -4521,7 +4520,7 @@ SUBROUTINE MZGAR1 COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -4646,7 +4645,7 @@ SUBROUTINE MZFORM (CHID,CHFORM,IXIOP) COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) COMMON /ZKRAKC/IQHOLK(120), IQKRAK(80), IQCETK(122) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -4712,7 +4711,7 @@ SUBROUTINE MZFORM (CHID,CHFORM,IXIOP) IF (NFRID.EQ.0) GO TO 71 28 IF (NFRIO.LT.16) GO TO 73 29 CONTINUE - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 RETURN 71 CALL MZPUSH (JQPDVS,LID,0,20,'I') LIX = LQ(KQSP+LID-1) @@ -4735,7 +4734,7 @@ SUBROUTINE MZFORM (CHID,CHFORM,IXIOP) FUNCTION MZFDIV (IXST,LIXP) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -4793,7 +4792,7 @@ SUBROUTINE MZFGAP COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -4829,8 +4828,12 @@ SUBROUTINE MZFGAP EQUIVALENCE (JSTOV(1),IQUEST(31)), (JPV(1), IQUEST(41)) DIMENSION NQGAPV(2) EQUIVALENCE (NQGAPV(1),NQGAPN) + INTEGER JDIV, JDVSH1, JDVSH2 + JDIV = 0 + JDVSH1 = 0 + JDVSH2 = 0 CALL VZEROI (IQGAP,20) - 15 DO 17 J=1,6 + DO 17 J=1,6 17 NGAPV(J) = 0 IF (JQSTMV.LT.0) GO TO 19 KT = NQOFFT(JQSTMV+1) @@ -4933,7 +4936,7 @@ SUBROUTINE MZFGAP SUBROUTINE MZTABC COMMON /MZCN/ IQLN,IQLS,IQNIO,IQID,IQNL,IQNS,IQND, IQNX,IQFOUL PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -5013,7 +5016,7 @@ SUBROUTINE MZTABC LQ(LQTE+2) = 0 LQ(LQTE+3) = 0 45 LQTE = LQTE + 4 - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 RETURN 91 NQCASE = 1 NQFATA = 3 @@ -5032,7 +5035,7 @@ SUBROUTINE MZTABF COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -5065,6 +5068,7 @@ SUBROUTINE MZTABF +, LQMTC1,LQMTC2, NQFRTC,NQLIVE DIMENSION NAMESR(2) DATA NAMESR / 4HMZTA, 4HBF / + INTEGER LCOLL JBIT(IZW,IZP) = IAND(ISHFT(IZW,-(IZP-1)),1) MQTRAC(NQTRAC+1) = NAMESR(1) MQTRAC(NQTRAC+2) = NAMESR(2) @@ -5073,6 +5077,7 @@ SUBROUTINE MZTABF NCOLL = 0 NGARB = 0 NQNOOP = 0 + LCOLL = 0 LFIXLO = NQLINK + 1 21 JDIV = LQ(LMT) IACT = LQ(LMT+1) @@ -5138,7 +5143,7 @@ SUBROUTINE MZTABF IF (NCOLL.EQ.0) GO TO 81 LQTE = LQRTA + LQ(LCOLL+5) 81 CONTINUE - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 END *------------------------------------------------------------------------------- @@ -5149,7 +5154,7 @@ SUBROUTINE MZTABH COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -5240,7 +5245,7 @@ SUBROUTINE MZTABM COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -5332,7 +5337,7 @@ SUBROUTINE MZTABM LQMTE = LMT LQMTLU = LMT LQ(LQMTE) = 21 - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 END *------------------------------------------------------------------------------- @@ -5343,7 +5348,7 @@ SUBROUTINE MZTABR COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -5436,7 +5441,7 @@ SUBROUTINE MZTABR IF (LMT.LT.LQMTE) GO TO 41 JDIV = LQ(LMT) LQ(LQTE) = LQSTA(KQT+JDIV) - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 RETURN 81 LMT = LQMTBR LQMTBR = 0 @@ -5466,7 +5471,7 @@ SUBROUTINE MZTABR SUBROUTINE MZTABS PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -5515,7 +5520,7 @@ SUBROUTINE MZTABS SUBROUTINE MZTABX PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -5574,7 +5579,7 @@ SUBROUTINE MZIOCH (IODVEC,NWIOMP,CHFORM) +, NQLOGD,NQLOGM,NQLOCK,NQDEVZ,NQOPTS(6) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /MZCA/ NQSTOR,NQOFFT(16),NQOFFS(16),NQALLO(16), NQIAM +, LQATAB,LQASTO,LQBTIS, LQWKTB,NQWKTB,LQWKFZ +, MQKEYS(3),NQINIT,NQTSYS,NQM99,NQPERM,NQFATA,NQCASE @@ -5827,7 +5832,7 @@ SUBROUTINE MZIOCH (IODVEC,NWIOMP,CHFORM) IQCETK(121) = IQBLAN IF (NQLOGM.GE.1) WRITE (IQLOG,9088) NWIO,CHFORM 9088 FORMAT (' MZIOCH-',I5,' extra I/O words for Format ',A) - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 RETURN 90 NQFATA = 2 IQUEST(12) = NCH @@ -5878,7 +5883,7 @@ SUBROUTINE MZFLAG (IXSTOR,LHEADP,KBITP,CHOPT) COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED COMMON /ZVFAUT/IQVID(2),IQVSTA,IQVLOG,IQVTHR(2),IQVREM(2,6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -5980,7 +5985,7 @@ SUBROUTINE MZFLAG (IXSTOR,LHEADP,KBITP,CHOPT) LX = LQ(LEV+1) LCUR = LQ(LEV+2) IF (LCUR.NE.0) GO TO 20 - 61 IQ(KQS+LHEAD) = MSBIT0 (IQ(KQS+LHEAD),IQSYSX) + IQ(KQS+LHEAD) = MSBIT0 (IQ(KQS+LHEAD),IQSYSX) IF (IOPTS.EQ.0) GO TO 999 IQ(KQS+LHEAD) = MSBIT (IQTVAL,IQ(KQS+LHEAD),IQTBIT) LQLIML = MIN (LQLIML,LHEAD) @@ -6010,7 +6015,7 @@ SUBROUTINE MZFLAG (IXSTOR,LHEADP,KBITP,CHOPT) SUBROUTINE MZGSTA (IGARB) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -6058,12 +6063,12 @@ SUBROUTINE MZGSTA (IGARB) SUBROUTINE MZIOCF (JUP,MXVAL) COMMON /ZKRAKC/IQHOLK(120), IQKRAK(80), IQCETK(122) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' DIMENSION MU(99) EQUIVALENCE (MU(1),IQHOLK(1)) EQUIVALENCE (NGR,IQUEST(1)), (NGRU,IQUEST(2)) - DIMENSION JUP(9), MXVAL(9) - JU = JUP(1) + DIMENSION MXVAL(*) + JU = JUP MXC = MU(JU+2) DO 24 JL=2,NGR JU = JU + 2 @@ -6078,7 +6083,7 @@ SUBROUTINE MZIOCF (JUP,MXVAL) *------------------------------------------------------------------------------- SUBROUTINE MZIOCR (IOW) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /MZIOC/ NWFOAV,NWFOTT,NWFODN,NWFORE,IFOCON(3) +, MFOSAV(2), JFOEND,JFOREP,JFOCUR,MFO(200) EQUIVALENCE (JIO,IQUEST(1)) @@ -6205,7 +6210,7 @@ SUBROUTINE MZIOCR (IOW) FUNCTION MZIXCO (IXAA,IXBB,IXCC,IXDD) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -6241,6 +6246,8 @@ FUNCTION MZIXCO (IXAA,IXBB,IXCC,IXDD) + ,ISHFT (ISHFT(MZ,32-NZB), -(33-IZP-NZB)) ) MBYTOR (MZ,IZW,IZP,NZB) = IOR (IZW, + ISHFT (ISHFT(MZ,32-NZB),-(33-IZP-NZB))) + INTEGER JSTORU + JSTORU = 0 IXV(1) = IXAA(1) IXV(2) = IXBB(1) IXV(3) = IXCC(1) @@ -6275,7 +6282,7 @@ FUNCTION MZIXCO (IXAA,IXBB,IXCC,IXDD) IF (JDV.LT.21) GO TO 93 47 IXCOMP = MSBIT1 (IXCOMP,JDV) 49 CONTINUE - 59 MZIXCO = IXCOMP + MZIXCO = IXCOMP RETURN 93 NQCASE = 1 92 NQCASE = NQCASE + 1 @@ -6300,7 +6307,7 @@ SUBROUTINE MZMOVE COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -6406,7 +6413,7 @@ SUBROUTINE MZPUDX (LP,NWP) +, IQCROP,IQVERT,IQCRCL,IQNOT, IQGRAV, IQILEG +, NQHOL0,NQHOLL(95) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -6421,13 +6428,12 @@ SUBROUTINE MZPUDX (LP,NWP) +, JQDVLL,JQDVSY,NQLOGL,NQSNAM(6) DIMENSION IQCUR(16) EQUIVALENCE (IQCUR(1),LQSTOR) - DIMENSION LP(9),NWP(9) MSBIT1 (IZW,IZP) = IOR (IZW, ISHFT(1,IZP-1)) MSBYT (MZ,IZW,IZP,NZB) = IOR ( + IAND (IZW, NOT(ISHFT (ISHFT(NOT(0),-(32-NZB)),IZP-1))) + ,ISHFT (ISHFT(MZ,32-NZB), -(33-IZP-NZB)) ) - L = LP(1) - NW = NWP(1) + L = LP + NW = NWP ND = NW - 10 N = MIN (10,NW) DO 12 J=0,N-1 @@ -6452,7 +6458,7 @@ SUBROUTINE MZRELB COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -6485,10 +6491,14 @@ SUBROUTINE MZRELB +, LQMTA,LQMTB,LQMTE,LQMTLU,LQMTBR +, LQMTC1,LQMTC2, NQFRTC,NQLIVE DIMENSION NAMESR(2) + INTEGER NRLTB2 DATA NAMESR / 4HMZRE, 4HLB / JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) + INTEGER LADTB1 + LADTB1 = 0 MQTRAC(NQTRAC+1) = NAMESR(1) MQTRAC(NQTRAC+2) = NAMESR(2) + NRLTB2 = 0 NQTRAC = NQTRAC + 2 LFIXLO = LQ(LQTA-1) LFIXRE = LQ(LQTA) @@ -6645,7 +6655,7 @@ SUBROUTINE MZRELL (MDESV) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -6682,6 +6692,8 @@ SUBROUTINE MZRELL (MDESV) DATA NAMESR / 4HMZRE, 4HLL / JBIT(IZW,IZP) = IAND(ISHFT(IZW,-(IZP-1)),1) JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) + INTEGER LADTB1 + LADTB1 = 0 MQTRAC(NQTRAC+1) = NAMESR(1) MQTRAC(NQTRAC+2) = NAMESR(2) NQTRAC = NQTRAC + 2 @@ -6788,7 +6800,7 @@ SUBROUTINE MZRELX COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -6830,7 +6842,7 @@ SUBROUTINE MZRELX CALL MZRELL (IQ(KQS+L+1)) ENDIF CALL MZRELB - 999 NQTRAC = NQTRAC - 2 + NQTRAC = NQTRAC - 2 END *------------------------------------------------------------------------------- @@ -6839,7 +6851,7 @@ SUBROUTINE MZSDIV (IXDIVP,IFLAGP) COMMON /ZSTATE/QVERSN,NQPHAS,IQDBUG,NQDCUT,NQWCUT,NQERR +, NQLOGD,NQLOGM,NQLOCK,NQDEVZ,NQOPTS(6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -6864,12 +6876,11 @@ SUBROUTINE MZSDIV (IXDIVP,IFLAGP) +, IQDN1(20), IQDN2(20), KQFT, LQFSTA(21) DIMENSION IQTABV(16) EQUIVALENCE (IQTABV(1),LQPSTO) - DIMENSION IXDIVP(9), IFLAGP(9) DIMENSION NAMESR(2) DATA NAMESR / 4HMZSD, 4HIV / JBYT(IZW,IZP,NZB) = ISHFT(ISHFT(IZW,33-IZP-NZB),-(32-NZB)) - IXIN = IXDIVP(1) - IFLAG = IFLAGP(1) + IXIN = IXDIVP + IFLAG = IFLAGP JSTO = JBYT (IXIN,27,4) IF (JSTO.NE.JQSTOR) GO TO 41 IF (IFLAG.LT.0) GO TO 48 @@ -6930,7 +6941,7 @@ SUBROUTINE ZSHUNT (IXSTOR,LSHP,LSUPP,JBIASP,IFLAGP) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE COMMON /ZUNITZ/IQDLUN,IQFLUN,IQHLUN, NQUSED PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -7076,7 +7087,7 @@ SUBROUTINE ZSHUNT (IXSTOR,LSHP,LSUPP,JBIASP,IFLAGP) SUBROUTINE ZHTOI (HOLL,INTV,NP) PARAMETER (NQTCET=256) COMMON /ZCETA/ IQCETA(256),IQTCET(256) - INTEGER INTV(99), HOLL(99) + INTEGER INTV(NP), HOLL(NP) DO 39 JWH=1,NP MWH = HOLL(JWH) INTW = 0 @@ -7096,7 +7107,7 @@ SUBROUTINE ZHTOI (HOLL,INTV,NP) SUBROUTINE RZSCAN(CHPATH,UROUT) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -7181,7 +7192,7 @@ SUBROUTINE RZSCAN(CHPATH,UROUT) GO TO 20 ENDIF ENDIF - 90 CALL RZCDIR(CHWOLD,' ') + CALL RZCDIR(CHWOLD,' ') 99 RETURN END @@ -7189,7 +7200,7 @@ SUBROUTINE RZSCAN(CHPATH,UROUT) SUBROUTINE MZWIPE (IXWP) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1)) @@ -7221,7 +7232,7 @@ SUBROUTINE RZEND(CHDIR) COMMON /ZSTATE/QVERSN,NQPHAS,IQDBUG,NQDCUT,NQWCUT,NQERR +, NQLOGD,NQLOGM,NQLOCK,NQDEVZ,NQOPTS(6) PARAMETER (IQDROP=25, IQMARK=26, IQCRIT=27, IQSYSX=28) - COMMON /QUEST/ IQUEST(100) + INCLUDE 'quest.inc' COMMON /ZEBQ/ IQFENC(4), LQ(100) DIMENSION IQ(92), Q(92) EQUIVALENCE (IQ(1),LQ(9)), (Q(1),IQ(1))