CDC   PROGRAM TMO(INPUT,OUTPUT,TEMP,REFINE,TAPE5=INPUT,TAPE6=OUTPUT,     KOHLREF
CDC  1 TAPE8=TEMP,TAPE9=REFINE)                                          KOHLREF
C                                                                        KOHL
C     PROGRAM TMO CALCULATES UNIT CELL PARAMETERS FROM GIVEN D-VALUES    KOHL
C        IT IS A NEWER VERSION OF PROGRAM TRI CONTAINING A SEPERAT CAL-  KOHL
C        CULATION FOR MONOCLINIC PRIMITIV LATTICES.CENTERED LATTICES ARE KOHL
C        TREATET AS PRIMITIV ONES.                                       KOHL
C                                                                        KOHL
C     THE LAST CARDS OF THE PROGRAM CONTAIN THE DUMMY FUNCTION           KOHL
C     SUBROUTINE SECOND.IF POSSIBLE THIS FUNCTION SHOULD BE REPLACED BY  KOHL
C     A FUNCTION SECOND(T) WHICH GIVES THE CURRENT EXECUTION TIME OF THE KOHL
C     JOB.SECOND HAS TWO PURPOSES 1. A TIME-LIMIT CAN BE STATED BY THE   KOHL
C     USER AND RESULTS ARE PRINTED BEFOR BREAKING OFF. 2. AN INTERNAL    KOHL
C     LOOP IS CONTROLLED AGAINST ENDLESSNES. HOWEWER THIS FUNCTION NEED  KOHL
C     NOT BE REPLACED.                                                   KOHL
C                                                                        KOHL
C     1. ONE CARD WITH ANY TITLE                                         KOHL
C     FURTHER DATA ARE READ UNDER CONTROL OF NAMELIST                    KOHL
C     THE FIRST CHARACTER IN EACH CARD MUST BE A BLANK                   KOHL
C     2. CARD CONTAINING  $OPA                                           KOHL
C        ON IBM MACHINES  $OPA SHOULD BE REPLACED BY  &OPA               KOHL
C     3. CONSECUTIVE DATA ITEMS SEPARATED BY COMMA,IN THE FOLLOWING FORM KOHL
C        X=Y,                                                            KOHL
C        X STANDS FOR A SYMBOLIC NAME LISTED BELOW                       KOHL
C        Y STANDS FOR THE NUMERIC VALUE OF X                             KOHL
C        THE ORDER OF THE DATA ITEMS IS FREE AND ALL THESE DATA ITEMS    KOHL
C        CAN BE OMITTED.IN THIS CASE THE DEFAULT VALUES ARE TAKEN.       KOHL
C                                                                        KOHL
C        SYMBOLIC NAMES, NUMERIC VALUE AND MEANING OF DATA ITEMS.        KOHL
C        NQ= NUMBER OF D-VALUES USED TO VERIFY THE FOUND CELLS           KOHL
C            DEFAULT=20                                                  KOHL
C        IORT=1   SEARCH FOR ORTHORHOMBIC AND TRICLINIC CELLS            KOHL
C            =2   SEARCH FOR ORTHORHOMBIC CELLS ONLY                     KOHL
C            =0   SEARCH FOR TRICLINIC (AND MONOCLINIC) CELLS ONLY       KOHL
C                 DEFAULT=1                                              KOHL
C        IUNAB=+1   SEARCH FOR INDEPENDENT BASIC LIST                    KOHL
C             =-1   FIRST LINES ARE TAKEN AS BASIC LINES                 KOHL
C                   DEFAULT=1                                            KOHL
C        LUFM=NUMBER OF FAIL LINES AMONG THE FIRST NQ LINES ALLOWED      KOHL
C             DEFAULT=0                                                  KOHL
C        I20=LOWEST M20 VALUE WITH COMPLETE PRINTOUT OF SOLUTION         KOHL
C            DEFAULT=7                                                   KOHL
C        FEHL=GREATEST RELATIVE ERROR OF Q= (DELTA Q)/Q                  KOHL
C             DEFAULT 0.01                                               KOHL
C        V1Z=VOLUME PER FORMULA UNIT OF UNIT CELL.                       KOHL
C            DEFAULT  NO RESTRICTION                                     KOHL
C        VD1Z=TOLERANCE ERROR OF V1Z                                     KOHL
C             DEFAULT=1.                                                 KOHL
C        NZMAX=MAXIMAL NUMBER OF MOLECULES PER UNIT CELL                 KOHL
C        IZE=1,2,3,4  CORRESPOND TO CASES 1,2,3,4 OF SETTING THE INDICES KOHL
C                     OF THE FIRST TWO LINES                             KOHL
C           =0   ALL VALUES 1,2,3,4  ARE TAKEN ONE AFTER EACH OTHER.     KOHL
C                DEFAULT=0                                               KOHL
C        HM4,KM4,LM4    STARTING VALUES OF INDICES H4,K4,L4              KOHL
C                       DEFAULT=0,1,1                                    KOHL
C        H4MAX,K4MAX,L4MAX=  MAXIMAL VALUES OF  H4,K4,L4                 KOHL
C                            UPPER LIMIT IS  4,4,4                       KOHL
C                            DEFAULT=2,2,2                               KOHL
C        ITA=1  GIVES PRINTOUT OF PROBABILITY VALUES OF POSSIBLE BASIC   KOHL
C               LINES                                                    KOHL
C               DEFAULT=0                                                KOHL
C        IM=2,3,4,5,6  HIGHEST INDEX OF THE BASIC LINES OF ORTHORMBIC    KOHL
C                      CELLS. IN MANY CASES IM=2 IS SUFFICIENT           KOHL
C                      DEFAULT=3                                         KOHL
C        TILI=TIMELIMIT IN SECONDS                                       KOHL
C        DEFAULT=7200.                                                   KOHL
C        WLENG=WAVELENGTH  IF  THETA-VALUES ARE REQUESTED ON OUTPUT      KOHL-CO
C     4. DATA ITEM FOR D-VALUES IN THE FORM D=Y1,Y2,Y3,....              KOHL
C        Y1,Y2,Y3,....  STANDS FOR THE D-VALUES                          KOHL
C        UNCERTAIN D-VALUES SHOULD BE PUT IN BEHIND THE NQ-TH LINE.      KOHL
C     5. LAST CARD CONTAINS  $END                                        KOHL
C        ON IBM MACHINES   $END SHOULD BE REPLACED BY  &END              KOHL
C                                                                        KOHL
C---MODIFIED (ULCC VERSION ONLY) TO WRITE SOLUTIONS TO REFINE FILE       REFTEXT
C---(CHANNEL 9) IN FORMAT SUITABLE FOR REFINEMENT BY FZON(6)             REFTEXT
C                                                                        KOHL
C     SAEMTLICHE DATENKARTEN DUERFEN ERST AB SPALTE ZWEI GELOCHT WERDEN  KOHL
C     1.  KARTE MIT BELIEBIGEM TEXT                                      KOHL
C     2.  KARTE MIT INHALT  $OPA                                         KOHL
C         DAS ZEICHEN  $  DARF NICHT IN DER ERSTEN SPALTE STEHEN         KOHL
C     3.  FOLGEKARTEN  ENTHALTEN DIE NACHSTEHENDEN PARAMETER  IN DER     KOHL
C           FORM  X=Y,                                                   KOHL
C           X  BEDEUTET DABEI DEN WORTLAUT DES PARAMETERS ZB.. FEHL      KOHL
C           Y BEDEUTET DEN INHALT DES PARAMETERS ZB. 0.005               KOHL
C         DIE REIHENFOLGE DER HIER ANGEFUEHRTEN PARAMETER IST BELIEBIG   KOHL
C         MIT AUSNAHME DES PARAMETERS  D  NACH WELCHEM DIE D-WERTE       KOHL
C         FOLGEN KOENNEN ALLE PARAMETER WEGGELASSEN WERDEN. ES WIRD      KOHL
C         DANN MIT DEN BEI DEFAULT ANGEGEBENEN WERTEN GERECHNET          KOHL
C         LISTE DER PARAMETER                                            KOHL
C         NQ=ZAHL DER D-WERTE ZUR UEBERPRUEFUNG DER GEFUNDENEN ZELLEN    KOHL
C            DEFAULT=20                                                  KOHL
C                                                                        KOHL
C         IORT=1    SUCHE NACH ORTHORHOMBISCHEN UND TRIKLINEN ZELLEN     KOHL
C             =2    NUR ORTHORHOMBISCHE ZELLEN GESUCHT                   KOHL
C             =NEGATIV ODER 0 ... NUR TRIKL. UND MONOKL. ZELLEN GESUCHT  KOHL
C              DEFAULT=1                                                 KOHL
C         IMON=1   SUCHE NACH MONOKLINEN UND TRIKLINEN ZELLEN            KOHL
C             =2   KEINE TRIKLINEN ZELLEN GESUCHT                        KOHL
C             =0   KEINE MONOKLINEN ZELLEN GESUCHT                       KOHL
C              DEFAULT=1                                                 KOHL
C         IUNAB=POSITIV ... SUCHE NACH UNABHAENGIGEN ANFANGSWERTEN       KOHL
C              =NEGATIV OD. 0 ... KEINE ABHAENGIGKEIT GESUCHT            KOHL
C               DEFAULT=1                                                KOHL
C         LUFM=ZAHL DER PARASITAEREN LINIEN                              KOHL
C              DEFAULT=0                                                 KOHL
C         ITER=ZAHL DER NAEHERUNGSSCHRITTE                               KOHL
C              DEFAULT=1                                                 KOHL
C         IQW=   KLEINSTER M20 WERT MIT LOESUNGSAUSDRUCK                 KOHL
C             DEFAULT=I20                                                KOHL
C         I20=KLEINSTER M20 -WERT MIT VOLLSTAENDIGEM LOESUNGSAUSDRUCK    KOHL
C             DEFAULT=7                                                0 KOHL
C         MQW=ZAHL DER NACH GROESSE GEORDNETEN Q-WERTE EINER LOESUNG     KOHL
C             DEFAULT=40                                                 KOHL
C         FEHL=MAXIMAL ZULAESSIGER FEHLER  DELTA Q/Q                     KOHL
C              DEFAULT=0.01                                              KOHL
C         V1Z=VOLUMEN FUER 1 MOLEKUEL/ZELLE                              KOHL
C             NUR WENN BEKANNT                                           KOHL
C         VD1Z=MOEGLICHE ABWEICHUNG DES MOLEKUELVOLUMENS VON V1Z         KOHL
C              DEFAULT=1.                                                KOHL
C         NZMAX=MAXIMALE ANZAHL MOLEKUELE/ZELLE                          KOHL
C              DEFAULT=10                                                KOHL
C         IZE=1...Q(1) UND Q(2) BEGRENZEN PRIMITIVE BASISFLAECHE         KOHL
C            =2...Q(1) ENTSPRICHT DEM DOPPELTEN BASISVEKTOR              KOHL
C            =3...Q(2) ENTSPRICHT DEM DOPPELTEN BASISVEKTOR              KOHL
C            =4...Q(1) UND Q(2) BEGRENZEN ZWEI PRIMITIVE BASISFLAECHEN   KOHL
C            =0...ES WERDEN ALLE WERTE IZE=1,2,3,4 DURCHLAUFEN           KOHL
C             DEFAULT=0                                                  KOHL
C         NLM=HOECHSTE INDIZIERUNG ...2 ODER 3                           KOHL
C             DEFAULT=2                                                  KOHL
C                                                                        KOHL
C         HM4,KM4,LM4 .... STARTWERTE FUER H4,K4,L4                    0 KOHL
C                          DEFAULT=         0, 1, 1                      KOHL
C         H4MAX,K4MAX,L4MAX=    HOECHSTWERTE   FUER H4,K4,L4             KOHL
C                        MAXIMALWERT= 4,4,4    DEFAULT = 2,2,2           KOHL
C         ITA=1 BEWIRKT AUSSCHRIFT DER WAHRSCHEINLICHKEITSWERTE AUS UNAB KOHL
C             DEFAULT= 0                                                 KOHL
C         IM=3,4,5,6        HOECHSTE INDIZIERUNGEN FUER DIE BASIS        KOHL
C                           DER ORTHORHOMBISCHEN ZELLEN                  KOHL
C            DEFAULT=3                                                   KOHL
C         ITEST=1   AUSSCHRIFT ALLER LOESUNGEN VOR AUSFUEHRUNG DER       KOHL
C                   OPTIMIERUNG                                          KOHL
C                   DEFAULT=0                                            KOHL
C         TILI=  ZEITLIMIT IN SEKUNDEN                                   KOHL
C                DEFAULT=7200.                                           KOHL
C         WLENG= WELLENLAENGE    WENN WINKEL THETA AUSGEGEBEN WERDEN     KOHL-CO
C     4.  D=D-WERTE  EINZELWERTE DURCH  ,  GETRENNT.                     KOHL
C         DAS ZEICHEN  $  DARF DABEI NICHT IN DER ERSTEN SPALTE STEHEN   KOHL
C     5.  LETZTE KARTE HAT DEN INHALT  $END                              KOHL
      INTEGER H1,H2,H3,H4,HM4,H2MM,H2MI,H3MI,H4MI,H2MA,H3MA,             KOHL
     1HE0,HE1,HE2,HD0,HD1,HD2,H4MA,H4MAX                                 KOHL
     2,HRE,HSU,HSU2                                                      KOHL
      LOGICAL LKP,LKN,LHP,LHN,HCH,KCH                                    KOHL
      REAL IQW,I20                                                       KOHL
      DIMENSION FS1(24),FS2(24),FS3(24),FS4(24),                         KOHL
     1FP1(24),FP2(24),FP3(24),FP4(24),FK1(24),FK2(24),FK3(24),FK4(24),   KOHL
     1DF1(24),DF2(24),DF3(24),DF4(24),DFK1(24),DFK2(24),DFK3(24),        KOHL
     3DFK4(24),TEXT(20),FEL(50),MFH(8),MFK(8)                            KOHL
     4,VK(10),VG(10),FN1(24),FN2(24),FN3(24),FN4(24)                     KOHL
     5,IQREI(24),DFF1(24),DFF2(24),DFF3(24),DFF4(24),DLM(24),QAN(50)     KOHL
     6,KIZ(4,4),D(50),S(50),IK(5)                                        KOHL
      COMMON FEL,Q(50),NNN,LUFM,FEHLP,ITER/SCHR/TEXT,IQW,I20,MQW         KOHL
     1,ITEST,QN,WLENG                                                    KOHL-CO
      COMMON /LSG/AZ(6,500),VVV(500)                                     KOHL
      COMMON /OR/IM,NQ                                                   KOHL
      COMMON /CQS/QS(2)                                                  KOHL
      COMMON /BEST/WMB                                                   KOHL
      COMMON /ZEIT/TILL                                                  KOHL
      EQUIVALENCE (D(1),VVV(1)),(VVV(51),S(1))                           KOHL
C---FOR USE WITH REFINE FILE FACILITY (ULCC)                             KOHLRFC
      DIMENSION TITLE(20)                                                KOHLRFC
      EQUIVALENCE (TITLE(1),TEXT(1)),(NOBS,NNN)                          KOHLRFC
      COMMON /REFCOM/ AMOLWT,DOBS,NSOL,ITEMCH,IREFCH                     KOHLRFC
      NAMELIST/OPA/NQ,IORT,IUNAB,LUFM,ITER,IQW,I20,MQW,ITA,ITEST,FEHL    KOHL
     1,V1Z,VD1Z,NZMAX,IZE,NLM,HM4,KM4,LM4,H4MAX,K4MAX,L4MAX,D,IAMT,IM    KOHL
     2,IMON,MOM,TILI,WLENG                                               KOHL-CO
      DATA    IORT,IUNAB,ITA/   1,1,0/,V1Z,VD1Z,NZMAX/-1.,1.,10/,IZE,NLM KOHL-1
     2/0,2/,HM4,KM4,LM4/0,1,1/,H4MAX,K4MAX,L4MAX/2,2,2/                  KOHL-1
      DATA IMON,MOM/1,3/                                                 KOHL-1
      DATA KIZ/1,0,0,1,2,0,0,1,1,0,0,2,1,1,-1,1/                         KOHL-1
      DATA IQREI/6,5,4,6,5,4,3,5,6,3,5,6,4,5,3,4,5,3,3,6,4,3,6,4/        KOHL-1
      DATA IK/1,2,3,4,5/                                                 KOHL-1
      DATA IAMT/1/                                                       KOHL-1
      DATA MFH/3,2,4,3,4,3,6,5/,MFK/1,2,2,3,2,3,3,4/                     KOHL-1
      DATA  TILI/7200./                                                  KOHL-1
C---STATEMENT FUNCTION DEFINITIONS FOLLOW                                KOHL-1
      IPAR(IZ)=IZ-2*(IZ/2)                                               KOHL
      PHI(QZ,PH,PK)=QZ-(A1*PH+A4*PK+A6*VVL)*PH-(A2*PK+ A5*VVL)*PK        KOHL
     1-A3*VVL**2                                                         KOHL
C---START OF EXECUTABLE STATEMENTS                                       KOHL-1
      DO 12 I=1,50                                                       KOHL
12    D(I)=0.                                                            KOHL
      WMB=0.                                                             KOHL
      WLENG=-1.                                                          KOHL-CO
      LUFM=0                                                             KOHL
      IM=3                                                               KOHL
      TRZ1=SECOND(TTZZ)                                                  KOHL
      NQ=20                                                              KOHL
      ITER=1                                                             KOHL
      IQW=-1.                                                            KOHL
      I20=7                                                              KOHL
      MQW=40                                                             KOHL
      ITEST=0                                                            KOHL
      FEHL=0.01                                                          KOHL
      READ(5,3000)TEXT                                                   KOHL
      READ(5,OPA)                                                        KOHL
      WRITE(6,3014)IORT,IUNAB,IZE,NLM,IM,ITA,HM4,KM4,LM4,H4MAX,K4MAX     KOHL
     +,L4MAX                                                             KOHL
      WRITE(6,3016)MOM,ITEST,TILI,IQW,IMON                               KOHL
      IF(IQW.LE.0.)IQW=I20                                               KOHL
      WRITE(6,3020)TEXT                                                  KOHL
      NNN=0                                                              KOHL
      IZER= 0                                                            KOHL
      IF(IZE.EQ.0)IZER=1                                                 KOHL
      IF(IZE.EQ.0)IZE=1                                                  KOHL
      DO 1 J=1,50                                                        KOHL
      IF(D(J).LT.0.00001)GO TO 2                                         KOHL
1     NNN=NNN+1                                                          KOHL
2     IF(NQ.GT.NNN)NQ=NNN                                                KOHL
      DO 9 I=1,NNN                                                       KOHL
      S(I)=1./VVV(I)                                                     KOHL
      Q(I)=S(I)**2                                                       KOHL
9     QAN(I)=Q(I)                                                        KOHL
      QS(1)=Q(1)                                                         KOHL
      QS(2)=Q(2)                                                         KOHL
      FEHLP=FEHL                                                         KOHL
      N20=20                                                             KOHL
      WRITE(6,3005)NQ,LUFM,FEHL                                          KOHL
      WRITE(6,3013)IK(1),VVV(1),S(1),Q(1)                                KOHL
      WRITE(6,3006)ITER                                                  KOHL
      WRITE(6,3013)IK(2),VVV(2),S(2),Q(2)                                KOHL
      WRITE(6,3007)V1Z,VD1Z                                              KOHL
      WRITE(6,3013)IK(3),VVV(3),S(3),Q(3)                                KOHL
      WRITE(6,3008)   NZMAX                                              KOHL
      WRITE(6,3013)IK(4),VVV(4),S(4),Q(4)                                KOHL
      IS20=I20+0.5                                                       KOHL
      WRITE(6,3012)MQW,IS20                                              KOHL
      WRITE(6,3013)IK(5),VVV(5),S(5),Q(5)                                KOHL
      WRITE(6,3017)                                                      KOHL-CO
      IF(WLENG.GT.0.)WRITE(6,3018)WLENG                                  KOHL-CO
      WRITE(6,3013)IQREI(1),VVV(6),S(6),Q(6)                             KOHL-CO
      WRITE(6,3015)(I,VVV(I),S(I),Q(I),I=7,NNN)                          KOHL-CO
      IF(NNN.LT.N20)N20=NNN                                              KOHL
C---REFINEMENT INITIALISATION (ULCC)                                     REFINIT
      CALL REFSET                                                        REFINIT
      QN=Q(N20)                                                          KOHL
      IF(IUNAB.LE.0)GO TO 18                                             KOHL
      TILL =TRZ1+0.90*TILI                                               KOHL
      CALL  ORDER(QAN,FEHLP,NQ)                                          KOHL
18    CONTINUE                                                           KOHL
      IF(IORT.LE.0)GO TO 3                                               KOHL
      CALL ORTHOR(V1Z,VD1Z,NZMAX,ITA)                                    KOHL
      IF(IORT.EQ.2)CALL EXIT                                             KOHL
3     IF(IMON.LE.0)GO TO 14                                              KOHL
      DO 4 I=1,NNN                                                       KOHL
4     Q(I)=QAN(I)                                                        KOHL
      CALL MONO (V1Z,VD1Z,NZMAX,NQ,MOM,IUNAB,QN)                         KOHL
      IF(WMB.GT.12..AND.NNN.GE.20)CALL EXIT                              KOHL
      IF(IMON.EQ.2)CALL EXIT                                             KOHL
14    CONTINUE                                                           KOHL
      IF(IUNAB.GT.0)CALL SORT1(NQ,QAN,50,1)                              KOHL
      DO 13 I=1,NNN                                                      KOHL
13    Q(I)=QAN(I)                                                        KOHL
      H4MA=H4MAX                                                         KOHL
      K4MA=K4MAX                                                         KOHL
      L4MA=L4MAX                                                         KOHL
      IAZ=0                                                              KOHL
      IF(IZE.EQ.2.OR.IZE.EQ.4)Q(1)=0.25*QAN(1)                           KOHL
      IF(IZE.EQ.3)Q(1)=QAN(1)                                            KOHL
      IF(IZE.GT.2)Q(2)=0.25*QAN(2)                                       KOHL
      IF(Q(1).LE.Q(2))GO TO 8                                            KOHL
      QQ=Q(1)                                                            KOHL
      Q(1)=Q(2)                                                          KOHL
      Q(2)=QQ                                                            KOHL
8     CONTINUE                                                           KOHL
      RA=SQRT(Q(2))                                                      KOHL
      IF(IZE-4)5,6,6                                                     KOHL
5     IZJ=1                                                              KOHL
      RA2=0.5*RA                                                         KOHL
      INN=-3                                                             KOHL
      IPK=0                                                              KOHL
      GO TO 7                                                            KOHL
6     IZJ=2                                                              KOHL
      RA2=0.6666*RA                                                      KOHL
      INN=1                                                              KOHL
      IPK=1                                                              KOHL
7     CONTINUE                                                           KOHL
      A=Q(1)                                                             KOHL
      B=Q(2)                                                             KOHL
      IF(SQRT(A).GE.RA2)INN=INN+1                                        KOHL
      INN=INN+2*NLM                                                      KOHL
      NLMH=MFH(INN)                                                      KOHL
      NLMK=MFK(INN)                                                      KOHL
      IDKG=2*NLMK+1                                                      KOHL
      VKL=QN**3/1600.                                                    KOHL
      IF(IZE.EQ.4)VKL=0.25*VKL                                           KOHL
      WRITE(6,3001)                                                      KOHL
      IF(IUNAB)11,11,10                                                  KOHL
10    WRITE(6,3002)                                                      KOHL
      CALL UNAB(Q,VVV,FEHLP,IZE,VKL,ITA)                                 KOHL
11    CONTINUE                                                           KOHL
      K4MA=K4MA+NLMK-NLM                                                 KOHL
      H4MA=H4MA+NLMH-NLM                                                 KOHL
      IF(K4MA.LT.1)K4MA=1                                                KOHL
      IF(H4MA.LT.1)H4MA=1                                                KOHL
      WRITE(6,3003)IZE,(KIZ(I,IZE),I=1,4),IZE                            KOHL
      WRITE(6,3009)                                                      KOHL
      WRITE(6,3010)(KIZ(I,IZE),I=1,4)                                    KOHL
      WRITE(6,3011)NLMH,NLMK,NLM,HM4,KM4,LM4,H4MA,K4MA,L4MA              KOHL
      VM=(1.-FEHLP)/(A*B*Q(4))                                           KOHL
      VM=SQRT(VM)                                                        KOHL
      IF(IZE.EQ.4)VM=VM*0.5                                              KOHL
      CALL VGR(QN,V1Z,VD1Z,NZMAX,VM,FEHLP,6,VK,VG,JV)                    KOHL
      AB4=A*B*4.                                                         KOHL
      APB=A+B                                                            KOHL
      AA4=4.*A                                                           KOHL
      DD=2.*(B-A)                                                        KOHL
      DLMIN=VKL/Q(4)*4.                                                  KOHL
      A3MIN=VKL/(A*B)                                                    KOHL
      NU=8                                                               KOHL
      NUM=NU-1                                                           KOHL
      Q1=Q(1)                                                            KOHL
      Q2=Q(2)                                                            KOHL
      Q3=Q(3)                                                            KOHL
      Q4=Q(4)                                                            KOHL
      Q5=Q(5)                                                            KOHL
      Q6=Q(6)                                                            KOHL
      Q7=Q(7)                                                            KOHL
      Q8=Q(8)                                                            KOHL
      A1=A                                                               KOHL
       A2=B                                                              KOHL
      Q34=Q3-Q4                                                          KOHL
      Q35=Q3-Q5                                                          KOHL
      Q36=Q3-Q6                                                          KOHL
      Q45=Q4-Q5                                                          KOHL
      Q46=Q4-Q6                                                          KOHL
      Q56=Q5-Q6                                                          KOHL
      NLM2=2*NLM                                                         KOHL
      ITP=-1                                                             KOHL
      DO 1200 L4=LM4,L4MA                                                KOHL
      L4ZJ=L4*IZJ                                                        KOHL
      L3MA=L4                                                            KOHL
      IF(L4.GT.NLM)L3MA=NLM                                              KOHL
      N41=L4*L4                                                          KOHL
      RN4=N41                                                            KOHL
      VKR=VKL*RN4                                                        KOHL
      DO 17 J=1,24                                                       KOHL
      IJ=IQREI(J)                                                        KOHL
      VKQ=VKR/Q(IJ)                                                      KOHL
      IF(DLMIN-VKQ)15,16,16                                              KOHL
15    DLM(J)=VKQ                                                         KOHL
      GO TO 17                                                           KOHL
16    DLM(J)=DLMIN                                                       KOHL
17    CONTINUE                                                           KOHL
      DO 1190 K4=KM4,K4MA                                                KOHL
      N43=K4*L4                                                          KOHL
      FK4Q=K4**2                                                         KOHL
      H4MI=HM4                                                           KOHL
      IF(IZJ.LE.1)GO TO 20                                               KOHL
      IZ=K4+HM4                                                          KOHL
      IF(IPAR(IZ))19,20,19                                               KOHL
19    H4MI=HM4+1                                                         KOHL
20    DO 1180 H4=H4MI,H4MA,IZJ                                           KOHL
      N42=H4*K4                                                          KOHL
      N44=H4*L4                                                          KOHL
      FH4Q=H4**2                                                         KOHL
      DO 1170 L3=1,L3MA                                                  KOHL
      L3ZJ=L3*IZJ                                                        KOHL
      N31=L3*L3                                                          KOHL
      H3MA=NLMH                                                          KOHL
      IF(L3-L4)23,22,23                                                  KOHL
22    KMA3=K4                                                            KOHL
      GO TO 24                                                           KOHL
23    KMA3=NLMK                                                          KOHL
      KMI=0                                                              KOHL
24    DO 1160 IIK3=KMI,KMA3                                              KOHL
      K3=IIK3                                                            KOHL
      IF(L3.EQ.L4.AND.K3.EQ.K4)H3MA=H4                                   KOHL
      IF(K4.EQ.0)K3=-K3                                                  KOHL
      IF(H4.EQ.0)H3=-H3                                                  KOHL
26    CONTINUE                                                           KOHL
      N33=K3*L3                                                          KOHL
      FK3Q=K3*K3                                                         KOHL
      M213=N31*N43-N41*N33                                               KOHL
      VM213=M213                                                         KOHL
      H3MI=0                                                             KOHL
      IF(IZJ.LE.1)GO TO 34                                               KOHL
      H3MI=IABS(IPAR(K3))                                                KOHL
34    DO 1150  IIH3=H3MI,H3MA,IZJ                                        KOHL
      H3=IIH3                                                            KOHL
      IF(H4.EQ.0.AND.K4.NE.0)H3=-H3                                      KOHL
36    CONTINUE                                                           KOHL
      HCH=.NOT.((L3.EQ.L4.AND.K3.EQ.K4.AND.H3.EQ.(-H4)).OR.(K4.EQ.0      KOHL
     1.AND.K3.EQ.0))                                                     KOHL
      KCH=.NOT.((L3.EQ.L4.AND.K3.EQ.(-K4).AND.H3.EQ.H4).OR.(K4.EQ        KOHL
     1.0.AND.K3.EQ.0))                                                   KOHL
      N32=H3*K3                                                          KOHL
      N34=H3*L3                                                          KOHL
      FH3Q=H3*H3                                                         KOHL
      M212=N31*N42-N41*N32                                               KOHL
      M214=N31*N44-N41*N34                                               KOHL
      M223=N32*N43-N42*N33                                               KOHL
      M224=N32*N44-N42*N34                                               KOHL
      M234=N33*N44-N43*N34                                               KOHL
      VM212=M212                                                         KOHL
      VM214=M214                                                         KOHL
      VM223=M223                                                         KOHL
      VM224=M224                                                         KOHL
      VM234=M234                                                         KOHL
      H2MA=NLMH                                                          KOHL
      DO 1140 L2=1,L3                                                    KOHL
      L2ZJ=L2*IZJ                                                        KOHL
      LSU=L4+L3+L2                                                       KOHL
      LSUZJ=LSU*IZJ                                                      KOHL
      N21=L2**2                                                          KOHL
      K2MM=0                                                             KOHL
      DO 1130 IIK2=KMI,NLMK                                              KOHL
      K2=IIK2                                                            KOHL
      IF(KCH)GO TO 46                                                    KOHL
      K2=-K2                                                             KOHL
      K2MM=K2MM+1                                                        KOHL
46    CONTINUE                                                           KOHL
      K2MM=K2MM+1                                                        KOHL
      IF(L3-L2)53,47,53                                                  KOHL
47    IF(IIK3-IIK2)1139,48,53                                            KOHL
48    IF(K3-K2)52,49,1139                                                KOHL
49    IF(H3)50,1139,51                                                   KOHL
50    H2MA=IIH3                                                          KOHL
      GO TO 53                                                           KOHL
51    H2MA=IIH3-1                                                        KOHL
      GO TO 53                                                           KOHL
52    IF(L3.EQ.L4.AND.IIK3.EQ.K4)H2MA=H4                                 KOHL
53    CONTINUE                                                           KOHL
      N23=K2*L2                                                          KOHL
      FK2Q=K2**2                                                         KOHL
      M313=N21*N43-N41*N23                                               KOHL
      M413=N21*N33-N31*N23                                               KOHL
      VM313=M313                                                         KOHL
      VM413=M413                                                         KOHL
      H2MI=0                                                             KOHL
      KRE=1                                                              KOHL
      KSU=K4+K3+K2                                                       KOHL
      KSU2=IABS(KSU+KSU)                                                 KOHL
      LKP=IABS(K4-L4).GT.K4MA.OR.IABS(K3-L3).GT.NLMK.OR.IABS(K2-L2)      KOHL
     1.GT.NLMK                                                           KOHL
      LKN=IABS(K4+L4).GT.K4MA.OR.IABS(K3+L3).GT.NLMK.OR.IABS(K2+L2)      KOHL
     1.GT.NLMK                                                           KOHL
      IF(KSU2.LE.LSU)GOTO54                                              KOHL
      IF(KSU)58,54,57                                                    KOHL
57    IF(LKP)GO TO 54                                                    KOHL
      GO TO 60                                                           KOHL
58    IF(LKN)GO TO 54                                                    KOHL
60    CONTINUE                                                           KOHL
      KRE=-1                                                             KOHL
54    CONTINUE                                                           KOHL
      IF(IZJ.LE.1)GO TO 55                                               KOHL
      H2MI=IABS(IPAR(K2))                                                KOHL
55    CONTINUE                                                           KOHL
      H2MM=H2MI-1                                                        KOHL
      DO 1120 IIH2=H2MI,H2MA,IZJ                                         KOHL
      H2=IIH2                                                            KOHL
      IF(HCH)GO TO 56                                                    KOHL
      H2=-H2                                                             KOHL
      H2MM=H2MM+1                                                        KOHL
56    CONTINUE                                                           KOHL
      HRE=1                                                              KOHL
      HSU=H4+H3+H2                                                       KOHL
      HSU2=IABS(HSU+HSU)                                                 KOHL
      LHP=IABS(H4-L4ZJ).GT.H4MA.OR.IABS(H3-L3ZJ).GT.NLMH.OR.IABS(H2-     KOHL
     1L2ZJ).GT.NLMH                                                      KOHL
      LHN= IABS(H4+L4ZJ).GT.H4MA.OR.IABS(H3+L3ZJ).GT.NLMH.OR.IABS(H2     KOHL
     1+L2ZJ).GT.NLMH                                                     KOHL
      IF(HSU2-LSUZJ)180,180,150                                          KOHL
150   IF(HSU)160,180,152                                                 KOHL
152   IF(LHP)GO TO 180                                                   KOHL
      GO TO 170                                                          KOHL
160   IF(LHN)GO TO 180                                                   KOHL
170   HRE=-1                                                             KOHL
180   CONTINUE                                                           KOHL
      H2MM=H2MM+1                                                        KOHL
      N22=H2*K2                                                          KOHL
      N24=H2*L2                                                          KOHL
      FH2Q=H2**2                                                         KOHL
      M312=N21*N42-N41*N22                                               KOHL
      M314=N21*N44-N41*N24                                               KOHL
      M323=N22*N43-N42*N23                                               KOHL
      M324=N22*N44-N42*N24                                               KOHL
      M334=N23*N44-N43*N24                                               KOHL
      M412=N21*N32-N31*N22                                               KOHL
      M414=N21*N34-N31*N24                                               KOHL
      M423=N22*N33-N32*N23                                               KOHL
      M424=N22*N34-N32*N24                                               KOHL
      M434=N23*N34-N33*N24                                               KOHL
      VM312=M312                                                         KOHL
      VM314=M314                                                         KOHL
      VM323=M323                                                         KOHL
      VM324=M324                                                         KOHL
      VM334=M334                                                         KOHL
      VM412=M412                                                         KOHL
      VM414=M414                                                         KOHL
      VM423=M423                                                         KOHL
      VM424=M424                                                         KOHL
      VM434=M434                                                         KOHL
      NG11=N22*M234-N32*M334+N42*M434                                    KOHL
      NG12=N21*M234-N31*M334+N41*M434                                    KOHL
      NG13=N24*M212-N34*M312+N44*M412                                    KOHL
      NG14=N23*M212-N33*M312+N43*M412                                    KOHL
      IF(NG11)64,61,64                                                   KOHL
61    IF(NG12)64,62,64                                                   KOHL
62    IF(NG13)64,63,64                                                   KOHL
63    IF(NG14)64,1109,64                                                 KOHL
64    CONTINUE                                                           KOHL
      G11=NG11                                                           KOHL
      G12=NG12                                                           KOHL
      G13=NG13                                                           KOHL
      G14=NG14                                                           KOHL
      IF(NG12.EQ.0.)GO TO 59                                             KOHL
      REG=2./G12                                                         KOHL
      DW1=REG*G11                                                        KOHL
      DW3=REG*G13                                                        KOHL
      DW4=-REG*G14                                                       KOHL
59    CONTINUE                                                           KOHL
      F341=0.                                                            KOHL
      F342=0.                                                            KOHL
      F343=0.                                                            KOHL
      F344=0.                                                            KOHL
      F241=0.                                                            KOHL
      F242=0.                                                            KOHL
      F243=0.                                                            KOHL
      F244=0.                                                            KOHL
      F141=G11                                                           KOHL
      F142=-G12                                                          KOHL
      F143=G13                                                           KOHL
      F144=-G14                                                          KOHL
      F131=G11                                                           KOHL
      F132=-G12                                                          KOHL
      F133=G13                                                           KOHL
      F134=-G14                                                          KOHL
      SHK12=-M234                                                        KOHL
      SHK13=M334                                                         KOHL
      SHK14=-M434                                                        KOHL
      SHK22=0.                                                           KOHL
      SHK23=0.                                                           KOHL
      SHK24=0.                                                           KOHL
      SHK32=M214                                                         KOHL
      SHK33=-M314                                                        KOHL
      SHK34=M414                                                         KOHL
      SHK42=-M213                                                        KOHL
      SHK43=M313                                                         KOHL
      SHK44=-M413                                                        KOHL
      DE0H=0.                                                            KOHL
      DBS12=0.                                                           KOHL
      DBS13=0.                                                           KOHL
      DBS14=0.                                                           KOHL
      DBS22=0.                                                           KOHL
      DBS23=0.                                                           KOHL
      DBS24=0.                                                           KOHL
      DBS32=0.                                                           KOHL
      DBS33=0.                                                           KOHL
      DBS34=0.                                                           KOHL
      DBS42=0.                                                           KOHL
      DBS43=0.                                                           KOHL
      DBS44=0.                                                           KOHL
      S2=Q4-A*FH2Q-B*FK2Q                                                KOHL
      S3=Q5-A*FH3Q-B*FK3Q                                                KOHL
      S4=Q6-A*FH4Q-B*FK4Q                                                KOHL
      GA1=-A*G11                                                         KOHL
      GA3=-A*G13                                                         KOHL
      GA2=A*G12                                                          KOHL
      GA4=A*G14                                                          KOHL
      IF(IPK)65,66,65                                                    KOHL
65    G4A1=4.*GA1                                                        KOHL
      G4A2=4.*GA2                                                        KOHL
      G4A3=4.*GA3                                                        KOHL
      G4A4=4.*GA4                                                        KOHL
      G12A1=12.*GA1                                                      KOHL
      G12A2=12.*GA2                                                      KOHL
      G12A3=12.*GA3                                                      KOHL
      G12A4=12.*GA4                                                      KOHL
      G20A1=20.*GA1                                                      KOHL
      G20A2=20.*GA2                                                      KOHL
      G20A3=20.*GA3                                                      KOHL
      G20A4=20.*GA4                                                      KOHL
      G28A1=28.*GA1                                                      KOHL
      G28A2=28.*GA2                                                      KOHL
      G28A3=28.*GA3                                                      KOHL
      G28A4=28.*GA4                                                      KOHL
       G8A1=8.*GA1                                                       KOHL
      G8A2=8.*GA2                                                        KOHL
      G8A3=8.*GA3                                                        KOHL
      G8A4=8.*GA4                                                        KOHL
      G16A1=16.*GA1                                                      KOHL
      G16A2=16.*GA2                                                      KOHL
      G16A3=16.*GA3                                                      KOHL
      G16A4=16.*GA4                                                      KOHL
      G24A1=24.*GA1                                                      KOHL
      G24A2=24.*GA2                                                      KOHL
      G24A3=24.*GA3                                                      KOHL
      G24A4=24.*GA4                                                      KOHL
66    CONTINUE                                                           KOHL
      G3A1=3.*GA1                                                        KOHL
      G3A2=3.*GA2                                                        KOHL
      G3A3=3.*GA3                                                        KOHL
      G3A4=3.*GA4                                                        KOHL
      G5A1=5.*GA1                                                        KOHL
      G5A2=5.*GA2                                                        KOHL
      G5A3=5.*GA3                                                        KOHL
      G5A4=5.*GA4                                                        KOHL
      G7A1=7.*GA1                                                        KOHL
      G7A2=7.*GA2                                                        KOHL
      G7A3=7.*GA3                                                        KOHL
      G7A4=7.*GA4                                                        KOHL
      SEK=0.                                                             KOHL
      DBK12=0.                                                           KOHL
      DBK13=0.                                                           KOHL
      DBK14=0.                                                           KOHL
      DBK22=0.                                                           KOHL
      DBK23=0.                                                           KOHL
      DBK24=0.                                                           KOHL
      DBK32=0.                                                           KOHL
      DBK33=0.                                                           KOHL
      DBK34=0.                                                           KOHL
      DBK42=0.                                                           KOHL
      DBK43=0.                                                           KOHL
      DBK44=0.                                                           KOHL
      GB1=-B*G11                                                         KOHL
      GB2=B*G12                                                          KOHL
      GB3=-B*G13                                                         KOHL
      GB4=B*G14                                                          KOHL
      G3B1=3.*GB1                                                        KOHL
      G3B2=3.*GB2                                                        KOHL
      G3B3=3.*GB3                                                        KOHL
      G3B4=3.*GB4                                                        KOHL
      G5B1=5.*GB1                                                        KOHL
      G5B2=5.*GB2                                                        KOHL
      G5B3=5.*GB3                                                        KOHL
      G5B4=5.*GB4                                                        KOHL
      G7B1=7.*GB1                                                        KOHL
      G7B2=7.*GB2                                                        KOHL
      G7B3=7.*GB3                                                        KOHL
      G7B4=7.*GB4                                                        KOHL
      IE=0                                                               KOHL
      RO=-1                                                              KOHL
      Z1=G11*Q3                                                          KOHL
      Z2=-G12*Q3                                                         KOHL
      Z3=G13*Q3                                                          KOHL
      Z4=-G14*Q3                                                         KOHL
      DEZL=0.                                                            KOHL
      TRZ2=SECOND(TTZZ)                                                  KOHL
      IF(IAMT)72,72,67                                                   KOHL
67    IF(TRZ2-TRZ1-TILI)72,72,68                                         KOHL
68    CONTINUE                                                           KOHL
      IF(IAZ.EQ.0)GO TO 1300                                             KOHL
      CALL AMT(IAZ,6)                                                    KOHL
      IF(IAZ-500)1300,69,69                                              KOHL
69    IAZ=0                                                              KOHL
         GO TO 101                                                       KOHL
72    RK1=0.                                                             KOHL
      RK2=0.                                                             KOHL
      RK3=0.                                                             KOHL
      RK4=0.                                                             KOHL
      IW=0                                                               KOHL
      IPK=IABS(IPK)                                                      KOHL
      ZK1=Z1+GB1                                                         KOHL
      ZK2=Z2+GB2                                                         KOHL
      ZK3=Z3+GB3                                                         KOHL
      ZK4=Z4+GB4                                                         KOHL
      ZV1=ZK1                                                            KOHL
      ZV2=ZK2                                                            KOHL
      ZV3=ZK3                                                            KOHL
      ZV4=ZK4                                                            KOHL
      DO 73 I=1,24                                                       KOHL
      DFK1(I)=0.                                                         KOHL
      DFK2(I)=0.                                                         KOHL
      DFK3(I)=0.                                                         KOHL
      DFK4(I)=0.                                                         KOHL
      FK1(I)=0.                                                          KOHL
      FK2(I)=0.                                                          KOHL
      FK3(I)=0.                                                          KOHL
73    FK4(I)=0.                                                          KOHL
      FK1(6)=-Q34*F141                                                   KOHL
      FK2(6)=-Q34*F142                                                   KOHL
      FK3(6)=-Q34*F143                                                   KOHL
      FK4(6)=-Q34*F144                                                   KOHL
      FK1(12)=-Q46*F141                                                  KOHL
      FK2(12)=-Q46*F142                                                  KOHL
      FK3(12)=-Q46*F143                                                  KOHL
      FK4(12)=-Q46*F144                                                  KOHL
      FK1(18)=Q56*F131                                                   KOHL
      FK2(18)=Q56*F132                                                   KOHL
      FK3(18)=Q56*F133                                                   KOHL
      FK4(18)=Q56*F134                                                   KOHL
      IDV=1                                                              KOHL
      IF(HRE.LT.0.OR.KRE.LT.0)GO TO 400                                  KOHL
      IF(NG12)280,400,280                                                KOHL
70    CONTINUE                                                           KOHL
      FS1(1)=0.                                                          KOHL
      FS2(1)=-Q56*F342                                                   KOHL
      FS3(1)=-Q56*F343                                                   KOHL
      FS4(1)=-Q56*F344                                                   KOHL
      FS1(2)=0.                                                          KOHL
      FS2(2)=-Q45*F242                                                   KOHL
      FS3(2)=-Q45*F243                                                   KOHL
      FS4(2)=-Q45*F244                                                   KOHL
      FS1(3)=0.                                                          KOHL
      FS2(3)=Q46*F342                                                    KOHL
      FS3(3)=Q46*F343                                                    KOHL
      FS4(3)=Q46*F344                                                    KOHL
      FS1(4)=0.                                                          KOHL
      FS2(4)=-Q56*F242                                                   KOHL
      FS3(4)=-Q56*F243                                                   KOHL
      FS4(4)=-Q56*F244                                                   KOHL
      FS1(5)=0.                                                          KOHL
      FS2(5)=-Q45*F342                                                   KOHL
      FS3(5)=-Q45*F343                                                   KOHL
      FS4(5)=-Q45*F344                                                   KOHL
      FS1(6)=-Q34*F141                                                   KOHL
      FS2(6)=-Q34*F142                                                   KOHL
      FS3(6)=-Q34*F143                                                   KOHL
      FS4(6)=-Q34*F144                                                   KOHL
      FS1(7)=0.                                                          KOHL
      FS2(7)=Q35*F342                                                    KOHL
      FS3(7)=Q35*F343                                                    KOHL
      FS4(7)=Q35*F344                                                    KOHL
      FS1(8)=0.                                                          KOHL
      FS2(8)=-FS2(4)                                                     KOHL
      FS3(8)=-FS3(4)                                                     KOHL
      FS4(8)=-FS4(4)                                                     KOHL
      FS1(9)=0.                                                          KOHL
      FS2(9)=-Q36*F342                                                   KOHL
      FS3(9)=-Q36*F343                                                   KOHL
      FS4(9)=-Q36*F344                                                   KOHL
      FS1(10)=0.                                                         KOHL
      FS2(10)=Q35*F242                                                   KOHL
      FS3(10)=Q35*F243                                                   KOHL
      FS4(10)=Q35*F244                                                   KOHL
      FS1(11)=0.                                                         KOHL
      FS2(11)=-FS2(1)                                                    KOHL
      FS3(11)=-FS3(1)                                                    KOHL
      FS4(11)=-FS4(1)                                                    KOHL
      FS1(12)=-Q46*F141                                                  KOHL
      FS2(12)=-Q46*F142                                                  KOHL
      FS3(12)=-Q46*F143                                                  KOHL
      FS4(12)=-Q46*F144                                                  KOHL
      FS1(13)=0.                                                         KOHL
      FS2(13)=-FS2(5)                                                    KOHL
      FS3(13)=-FS3(5)                                                    KOHL
      FS4(13)=-FS4(5)                                                    KOHL
      FS1(14)=0.                                                         KOHL
      FS2(14)=-FS2(10)                                                   KOHL
      FS3(14)=-FS3(10)                                                   KOHL
      FS4(14)=-FS4(10)                                                   KOHL
      FS1(15)=0.                                                         KOHL
      FS2(15)=Q34*F342                                                   KOHL
      FS3(15)=Q34*F343                                                   KOHL
      FS4(15)=Q34*F344                                                   KOHL
      FS1(16)=0.                                                         KOHL
      FS2(16)=-FS2(2)                                                    KOHL
      FS3(16)=-FS3(2)                                                    KOHL
      FS4(16)=-FS4(2)                                                    KOHL
      FS1(17)=0.                                                         KOHL
      FS2(17)=-FS2(7)                                                    KOHL
      FS3(17)=-FS3(7)                                                    KOHL
      FS4(17)=-FS4(7)                                                    KOHL
      FS1(18)=Q56*F131                                                   KOHL
      FS2(18)=Q56*F132                                                   KOHL
      FS3(18)=Q56*F133                                                   KOHL
      FS4(18)=Q56*F134                                                   KOHL
      FS1(19)=0.                                                         KOHL
      FS2(19)=-FS2(9)                                                    KOHL
      FS3(19)=-FS3(9)                                                    KOHL
      FS4(19)=-FS4(9)                                                    KOHL
      FS1(20)=0.                                                         KOHL
      FS2(20)=-Q46*F242                                                  KOHL
      FS3(20)=-Q46*F243                                                  KOHL
      FS4(20)=-Q46*F244                                                  KOHL
      FS1(21)=0.                                                         KOHL
      FS2(21)=-FS2(15)                                                   KOHL
      FS3(21)=-FS3(15)                                                   KOHL
      FS4(21)=-FS4(15)                                                   KOHL
      FS1(22)=0.                                                         KOHL
      FS2(22)=Q36*F242                                                   KOHL
      FS3(22)=Q36*F243                                                   KOHL
      FS4(22)=Q36*F244                                                   KOHL
      FS1(23)=0.                                                         KOHL
      FS2(23)=-FS2(3)                                                    KOHL
      FS3(23)=-FS3(3)                                                    KOHL
      FS4(23)=-FS4(3)                                                    KOHL
      DO 75 I=1,23                                                       KOHL
      FP1(I)=FS1(I)                                                      KOHL
      FP2(I)=FS2(I)                                                      KOHL
      FP3(I)=FS3(I)                                                      KOHL
      FP4(I)=FS4(I)                                                      KOHL
      FK1(I)=FS1(I)                                                      KOHL
      FK2(I)=FS2(I)                                                      KOHL
      FK3(I)=FS3(I)                                                      KOHL
      FK4(I)=FS4(I)                                                      KOHL
75    CONTINUE                                                           KOHL
      IB=1                                                               KOHL
      ID=1                                                               KOHL
      IPK=-IABS(IPK)                                                     KOHL
      NEP=0                                                              KOHL
      DB12=DBS12                                                         KOHL
      DB13=DBS13                                                         KOHL
      DB14=DBS14                                                         KOHL
      DB22=DBS22                                                         KOHL
      DB23=DBS23                                                         KOHL
      DB24=DBS24                                                         KOHL
      DB32=DBS32                                                         KOHL
      DB33=DBS33                                                         KOHL
      DB34=DBS34                                                         KOHL
      DB42=DBS42                                                         KOHL
      DB43=DBS43                                                         KOHL
      DB44=DBS44                                                         KOHL
      DEH=DE0H                                                           KOHL
      DBH12=   DB12                                                      KOHL
      DBH13=DB13                                                         KOHL
      DBH14=DB14                                                         KOHL
      DBH22=DB22                                                         KOHL
      DBH23=DB23                                                         KOHL
      DBH24=DB24                                                         KOHL
      DBH32=DB32                                                         KOHL
      DBH33=DB33                                                         KOHL
      DBH34=DB34                                                         KOHL
      DBH42=DB42                                                         KOHL
       DBH43=DB43                                                        KOHL
      DBH44=DB44                                                         KOHL
      DELH=DEH                                                           KOHL
      DEP=DEZL                                                           KOHL
      DEN=DEZL                                                           KOHL
      DEZK=DEZL                                                          KOHL
      B1=Z1                                                              KOHL
      B2=Z2                                                              KOHL
      B3=Z3                                                              KOHL
      B4=Z4                                                              KOHL
      ZK1=Z1                                                             KOHL
      ZK2=Z2                                                             KOHL
      ZK3=Z3                                                             KOHL
      ZK4=Z4                                                             KOHL
      K1=0                                                               KOHL
80    CONTINUE                                                           KOHL
      NPROB=25                                                           KOHL
      IPK=-IPK                                                           KOHL
       IF(L2-IE)84,82,84                                                 KOHL
82    IF(ID-K2MM)86,83,83                                                KOHL
83    IW=-1                                                              KOHL
      IF(H2MM)1109,1109,88                                               KOHL
84    IF(IE)86,85,86                                                     KOHL
85    IW=0                                                               KOHL
      GO TO 89                                                           KOHL
86    IW=1                                                               KOHL
88    CONTINUE                                                           KOHL
      KS=KSU+K1                                                          KOHL
      KS2=IABS(KS+KS)                                                    KOHL
      IF(KS2.LE.LSUK)GO TO 89                                            KOHL
      IF(KS)2015,89,2010                                                 KOHL
2010  IF(LKP.OR.IABS(K1-IE).GT.NLMK)GO TO 89                             KOHL
      GO TO 240                                                          KOHL
2015  IF(LKN.OR.IABS(K1+IE).GT.NLMK)GO TO 89                             KOHL
      GO TO 240                                                          KOHL
89    CONTINUE                                                           KOHL
      IA=1                                                               KOHL
      H1=0                                                               KOHL
      IF(IPK)114,90,90                                                   KOHL
90    CONTINUE                                                           KOHL
      IF(NEP)92,102,102                                                  KOHL
92    IF(ABS(DEN)-0.50)107,93,93                                         KOHL
93    DENI=1./DEN                                                        KOHL
      K=0                                                                KOHL
96    K=K+1                                                              KOHL
      A3=B1*DENI                                                         KOHL
      IF(A3-A3MIN)95,95,94                                               KOHL
94    A4=B2*DENI                                                         KOHL
      DL=AB4-A4**2                                                       KOHL
      IF(DL-DLM(K))95,95,81                                              KOHL
81    A5=B3*DENI                                                         KOHL
      A6=B4*DENI                                                         KOHL
      GO TO 500                                                          KOHL
95    CONTINUE                                                           KOHL
      B1=B1+FN1(K)                                                       KOHL
      B2=B2+FN2(K)                                                       KOHL
      B3=B3+FN3(K)                                                       KOHL
      B4=B4+FN4(K)                                                       KOHL
      IF(K.LT.24)GO TO 96                                                KOHL
      GO TO 107                                                          KOHL
100   IF(NEP)95,105,105                                                  KOHL
101   IF(NEP)95,97,97                                                    KOHL
102   IF(ABS(DEP)-0.50)107,103,103                                       KOHL
103   DEPI=1./DEP                                                        KOHL
      K=0                                                                KOHL
106   K=K+1                                                              KOHL
      IDV=IABS(IDV)                                                      KOHL
      H1=IABS(H1)                                                        KOHL
      A4=B2*DEPI                                                         KOHL
      DL=AB4-A4**2                                                       KOHL
      IF(DL-DLM(K))112,112,87                                            KOHL
87    A3=B1*DEPI                                                         KOHL
      IF(A3-A3MIN)97,97,104                                              KOHL
104   A5=B3*DEPI                                                         KOHL
      A6=B4*DEPI                                                         KOHL
      GO TO 500                                                          KOHL
97    CONTINUE                                                           KOHL
      IF(IDV)112,112,98                                                  KOHL
98    IDV=-IDV                                                           KOHL
      A3= (B1+B2*DW1)*DEPI                                               KOHL
      IF(A3-A3MIN)112,112,99                                             KOHL
99    A5= (B3+B2*DW3)*DEPI                                               KOHL
      A6= (B4+B2*DW4)*DEPI                                               KOHL
      A4=-B2*DEPI                                                        KOHL
      H1=-H1                                                             KOHL
      IF(IZE.EQ.4)DL=DL*0.25                                             KOHL
      GO TO 500                                                          KOHL
105   CONTINUE                                                           KOHL
      IF(IDV)112,112,111                                                 KOHL
111   IDV=-IDV                                                           KOHL
      A3=A3+A4*DW1                                                       KOHL
      IF(A3-A3MIN)112,112,109                                            KOHL
109   A5=A5+A4*DW3                                                       KOHL
      A6=A6+A4*DW4                                                       KOHL
      A4=-A4                                                             KOHL
      H1=-H1                                                             KOHL
      GO TO 500                                                          KOHL
112   B1=B1+FP1(K)                                                       KOHL
      B2=B2+FP2(K)                                                       KOHL
      B3=B3+FP3(K)                                                       KOHL
      B4=B4+FP4(K)                                                       KOHL
      IF(K.LT.24)GO TO 106                                               KOHL
107   CONTINUE                                                           KOHL
      IF(IW)108,113,110                                                  KOHL
108   IF(IA-H2MM)113,240,240                                             KOHL
110   IF(IABS(H1)-NLMH)113,117,240                                       KOHL
117   IF(H1)240,240,113                                                  KOHL
113   CONTINUE                                                           KOHL
      GO TO (114,220,125,230,130,230,135,230,240),IA                     KOHL
114   CONTINUE                                                           KOHL
      IA=2                                                               KOHL
      IB=1                                                               KOHL
      H1=1                                                               KOHL
      IF(IZJ-1)120,120,116                                               KOHL
116   IF(IPK.LT.0)GO TO 120                                              KOHL
      DELH=DELH+DELH                                                     KOHL
      IH1=1                                                              KOHL
      BV1=ZK1+G4A1                                                       KOHL
      BV2=ZK2+G4A2                                                       KOHL
      BV3=ZK3+G4A3                                                       KOHL
      BV4=ZK4+G4A4                                                       KOHL
      G3A1=G12A1                                                         KOHL
      G3A2=G12A2                                                         KOHL
      G3A3=G12A3                                                         KOHL
      G3A4=G12A4                                                         KOHL
      G5A1=G20A1                                                         KOHL
      G5A2=G20A2                                                         KOHL
      G5A3=G20A3                                                         KOHL
      G5A4=G20A4                                                         KOHL
      G7A1=G28A1                                                         KOHL
      G7A2=G28A2                                                         KOHL
      G7A3=G28A3                                                         KOHL
      G7A4=G28A4                                                         KOHL
118   DB12=DBH12+DBH12                                                   KOHL
      DB13=DBH13+DBH13                                                   KOHL
      DB14=DBH14+DBH14                                                   KOHL
      DB22=DBH22+DBH22                                                   KOHL
      DB23=DBH23+DBH23                                                   KOHL
      DB24=DBH24+DBH24                                                   KOHL
      DB32=DBH32+DBH32                                                   KOHL
      DB33=DBH33+DBH33                                                   KOHL
      DB34=DBH34+DBH34                                                   KOHL
      DB42=DBH42+DBH42                                                   KOHL
      DB43=DBH43+DBH43                                                   KOHL
      DB44=DBH44+DBH44                                                   KOHL
      GO TO (121,121,122),IB                                             KOHL
120   CONTINUE                                                           KOHL
      BV1=ZK1+GA1                                                        KOHL
      BV2=ZK2+GA2                                                        KOHL
      BV3=ZK3+GA3                                                        KOHL
      BV4=ZK4+GA4                                                        KOHL
121   CONTINUE                                                           KOHL
      R1=DB12*S2+DB13*S3+DB14*S4                                         KOHL
      R2=DB22*S2+DB23*S3+DB24*S4                                         KOHL
      R3=DB32*S2+DB33*S3+DB34*S4                                         KOHL
      R4=DB42*S2+DB43*S3+DB44*S4                                         KOHL
      RV1=R1                                                             KOHL
      RV2=R2                                                             KOHL
      RV3=R3                                                             KOHL
      RV4=R4                                                             KOHL
122   CONTINUE                                                           KOHL
      DF341=DB13-DB14                                                    KOHL
      DF342=DB23-DB24                                                    KOHL
      DF343=DB33-DB34                                                    KOHL
      DF344=DB43-DB44                                                    KOHL
      DF241=DB12-DB14                                                    KOHL
      DF242=DB22-DB24                                                    KOHL
      DF243=DB32-DB34                                                    KOHL
      DF244=DB42-DB44                                                    KOHL
      DF1(1)=-Q56*DF341                                                  KOHL
      DF2(1)=-Q56*DF342                                                  KOHL
      DF3(1)=-Q56*DF343                                                  KOHL
      DF4(1)=-Q56*DF344                                                  KOHL
      DF1(2)=-Q45*DF241                                                  KOHL
      DF2(2)=-Q45*DF242                                                  KOHL
      DF3(2)=-Q45*DF243                                                  KOHL
      DF4(2)=-Q45*DF244                                                  KOHL
      DF1(3)=Q46*DF341                                                   KOHL
      DF2(3)=Q46*DF342                                                   KOHL
      DF3(3)=Q46*DF343                                                   KOHL
      DF4(3)=Q46*DF344                                                   KOHL
      DF1(4)=-Q56*DF241                                                  KOHL
      DF2(4)=-Q56*DF242                                                  KOHL
      DF3(4)=-Q56*DF243                                                  KOHL
      DF4(4)=-Q56*DF244                                                  KOHL
      DF1(5)=-Q45*DF341                                                  KOHL
      DF2(5)=-Q45*DF342                                                  KOHL
      DF3(5)=-Q45*DF343                                                  KOHL
      DF4(5)=-Q45*DF344                                                  KOHL
      DF1(6)=Q34*DB14                                                    KOHL
      DF2(6)=Q34*DB24                                                    KOHL
      DF3(6)=Q34*DB34                                                    KOHL
      DF4(6)=Q34*DB44                                                    KOHL
      DF1(7)=Q35*DF341                                                   KOHL
      DF2(7)=Q35*DF342                                                   KOHL
      DF3(7)=Q35*DF343                                                   KOHL
      DF4(7)=Q35*DF344                                                   KOHL
      DF1(8)=-DF1(4)                                                     KOHL
      DF2(8)=-DF2(4)                                                     KOHL
      DF3(8)=-DF3(4)                                                     KOHL
      DF4(8)=-DF4(4)                                                     KOHL
      DF1(9)=-Q36*DF341                                                  KOHL
      DF2(9)=-Q36*DF342                                                  KOHL
      DF3(9)=-Q36*DF343                                                  KOHL
      DF4(9)=-Q36*DF344                                                  KOHL
      DF1(10)=Q35*DF241                                                  KOHL
      DF2(10)=Q35*DF242                                                  KOHL
      DF3(10)=Q35*DF243                                                  KOHL
      DF4(10)=Q35*DF244                                                  KOHL
      DF1(11)=-DF1(1)                                                    KOHL
      DF2(11)=-DF2(1)                                                    KOHL
      DF3(11)=-DF3(1)                                                    KOHL
      DF4(11)=-DF4(1)                                                    KOHL
      DF1(12)=Q46*DB14                                                   KOHL
      DF2(12)=Q46*DB24                                                   KOHL
      DF3(12)=Q46*DB34                                                   KOHL
      DF4(12)=Q46*DB44                                                   KOHL
      DF1(13)=-DF1(5)                                                    KOHL
      DF2(13)=-DF2(5)                                                    KOHL
      DF3(13)=-DF3(5)                                                    KOHL
      DF4(13)=-DF4(5)                                                    KOHL
      DF1(14)=-DF1(10)                                                   KOHL
      DF2(14)=-DF2(10)                                                   KOHL
      DF3(14)=-DF3(10)                                                   KOHL
      DF4(14)=-DF4(10)                                                   KOHL
      DF1(15)=Q34*DF341                                                  KOHL
      DF2(15)=Q34*DF342                                                  KOHL
      DF3(15)=Q34*DF343                                                  KOHL
      DF4(15)=Q34*DF344                                                  KOHL
      DF1(16)=-DF1(2)                                                    KOHL
      DF2(16)=-DF2(2)                                                    KOHL
      DF3(16)=-DF3(2)                                                    KOHL
      DF4(16)=-DF4(2)                                                    KOHL
      DF1(17)=-DF1(7)                                                    KOHL
      DF2(17)=-DF2(7)                                                    KOHL
      DF3(17)=-DF3(7)                                                    KOHL
      DF4(17)=-DF4(7)                                                    KOHL
      DF1(18)=-Q56*DB13                                                  KOHL
      DF2(18)=-Q56*DB23                                                  KOHL
      DF3(18)=-Q56*DB33                                                  KOHL
      DF4(18)=-Q56*DB43                                                  KOHL
      DF1(19)=-DF1(9)                                                    KOHL
      DF2(19)=-DF2(9)                                                    KOHL
      DF3(19)=-DF3(9)                                                    KOHL
      DF4(19)=-DF4(9)                                                    KOHL
      DF1(20)=-Q46*DF241                                                 KOHL
      DF2(20)=-Q46*DF242                                                 KOHL
      DF3(20)=-Q46*DF243                                                 KOHL
      DF4(20)=-Q46*DF244                                                 KOHL
      DF1(21)=-DF1(15)                                                   KOHL
      DF2(21)=-DF2(15)                                                   KOHL
      DF3(21)=-DF3(15)                                                   KOHL
      DF4(21)=-DF4(15)                                                   KOHL
      DF1(22)=Q36*DF241                                                  KOHL
      DF2(22)=Q36*DF242                                                  KOHL
      DF3(22)=Q36*DF243                                                  KOHL
      DF4(22)=Q36*DF244                                                  KOHL
      DF1(23)=-DF1(3)                                                    KOHL
      DF2(23)=-DF2(3)                                                    KOHL
      DF3(23)=-DF3(3)                                                    KOHL
      DF4(23)=-DF4(3)                                                    KOHL
      GO TO (202,270,128),IB                                             KOHL
125   CONTINUE                                                           KOHL
      IF(IPK.GE.0)GO TO 128                                              KOHL
      G3A1=G8A1                                                          KOHL
      G3A2=G8A2                                                          KOHL
      G3A3=G8A3                                                          KOHL
      G3A4=G8A4                                                          KOHL
      G5A1=G16A1                                                         KOHL
      G5A2=G16A2                                                         KOHL
      G5A3=G16A3                                                         KOHL
      G5A4=G16A4                                                         KOHL
      G7A1=G24A1                                                         KOHL
      G7A2=G24A2                                                         KOHL
      G7A3=G24A3                                                         KOHL
      G7A4=G24A4                                                         KOHL
      R1=R1+R1                                                           KOHL
      R2=R2+R2                                                           KOHL
      R3=R3+R3                                                           KOHL
      R4=R4+R4                                                           KOHL
      IB=3                                                               KOHL
      GO TO 118                                                          KOHL
128   CONTINUE                                                           KOHL
      BV1=BV1+G3A1                                                       KOHL
      BV2=BV2+G3A2                                                       KOHL
      BV3=BV3+G3A3                                                       KOHL
      BV4=BV4+G3A4                                                       KOHL
      IA=4                                                               KOHL
      GO TO 200                                                          KOHL
130   BV1=BV1+G5A1                                                       KOHL
      BV2=BV2+G5A2                                                       KOHL
      BV3=BV3+G5A3                                                       KOHL
      BV4=BV4+G5A4                                                       KOHL
      IA=6                                                               KOHL
      GO TO 200                                                          KOHL
135   BV1=BV1+G7A1                                                       KOHL
      BV2=BV2+G7A2                                                       KOHL
      BV3=BV3+G7A3                                                       KOHL
      BV4=BV4+G7A4                                                       KOHL
      IA=8                                                               KOHL
200   CONTINUE                                                           KOHL
      RV1=RV1+R1                                                         KOHL
      RV2=RV2+R2                                                         KOHL
      RV3=RV3+R3                                                         KOHL
      RV4=RV4+R4                                                         KOHL
      H1=IABS(H1)+1                                                      KOHL
202   CONTINUE                                                           KOHL
      IF(IE.EQ.0)IA=IA+1                                                 KOHL
      NEP=1                                                              KOHL
      DEP=DEP+DELH                                                       KOHL
      B1=BV1+RV1                                                         KOHL
      B2=BV2+RV2                                                         KOHL
      B3=BV3+RV3                                                         KOHL
      B4=BV4+RV4                                                         KOHL
      DO 205 I=1,23                                                      KOHL
      FP1(I)=FP1(I)+DF1(I)                                               KOHL
      FP2(I)=FP2(I)+DF2(I)                                               KOHL
      FP3(I)=FP3(I)+DF3(I)                                               KOHL
205   FP4(I)=FP4(I)+DF4(I)                                               KOHL
      IF(IPK)213,90,219                                                  KOHL
213   IF(IA.LE.3)GO TO 90                                                KOHL
218   DEP=DEP+DEH                                                        KOHL
219   H1=H1+1                                                            KOHL
      GO TO 90                                                           KOHL
220   IA=3                                                               KOHL
      H1=-H1                                                             KOHL
      DEN=DEN-DELH                                                       KOHL
      B1=BV1-RV1                                                         KOHL
      B2=BV2-RV2                                                         KOHL
      B3=BV3-RV3                                                         KOHL
      B4=BV4-RV4                                                         KOHL
      DO 222 I=1,24                                                      KOHL
      FN1(I)=FK1(I)-DF1(I)                                               KOHL
      FN2(I)=FK2(I)-DF2(I)                                               KOHL
      FN3(I)=FK3(I)-DF3(I)                                               KOHL
222   FN4(I)=FK4(I)-DF4(I)                                               KOHL
      NEP=-1                                                             KOHL
      GO TO 90                                                           KOHL
230   IA=IA+1                                                            KOHL
      NEP=-1                                                             KOHL
      H1=-H1                                                             KOHL
      DEN=DEN-DELH                                                       KOHL
      B1=BV1-RV1                                                         KOHL
      B2=BV2-RV2                                                         KOHL
      B3=BV3-RV3                                                         KOHL
      B4=BV4-RV4                                                         KOHL
      DO 232 I=1,23                                                      KOHL
      FN1(I)=FN1(I)-DF1(I)                                               KOHL
      FN2(I)=FN2(I)-DF2(I)                                               KOHL
      FN3(I)=FN3(I)-DF3(I)                                               KOHL
232   FN4(I)=FN4(I)-DF4(I)                                               KOHL
      IF(IPK)233,90,90                                                   KOHL
233   DEN=DEN-DEH                                                        KOHL
      GO TO 90                                                           KOHL
240   CONTINUE                                                           KOHL
      IF(IW)440,253,248                                                  KOHL
248   IF(ID-IDKG)253,400,400                                             KOHL
253   CONTINUE                                                           KOHL
      GO TO (265,350,290,350,295,350,300,350,400),ID                     KOHL
265   CONTINUE                                                           KOHL
      RK1=DBK12*S2+DBK13*S3+DBK14*S4                                     KOHL
      RK2=DBK22*S2+DBK23*S3+DBK24*S4                                     KOHL
      RK3=DBK32*S2+DBK33*S3+DBK34*S4                                     KOHL
      RK4=DBK42*S2+DBK43*S3+DBK44*S4                                     KOHL
      ZV1=Z1+GB1                                                         KOHL
      ZV2=Z2+GB2                                                         KOHL
      ZV3=Z3+GB3                                                         KOHL
      ZV4=Z4+GB4                                                         KOHL
      DB12=DBK12                                                         KOHL
      DB13=DBK13                                                         KOHL
      DB14=DBK14                                                         KOHL
      DB22=DBK22                                                         KOHL
      DB23=DBK23                                                         KOHL
      DB24=DBK24                                                         KOHL
      DB32=DBK32                                                         KOHL
      DB33=DBK33                                                         KOHL
      DB34=DBK34                                                         KOHL
      DB42=DBK42                                                         KOHL
      DB43=DBK43                                                         KOHL
      DB44=DBK44                                                         KOHL
      IB=2                                                               KOHL
      GO TO 122                                                          KOHL
270   CONTINUE                                                           KOHL
      DO 273 I=1,23                                                      KOHL
      DFK1(I)=DF1(I)                                                     KOHL
      DFK2(I)=DF2(I)                                                     KOHL
      DFK3(I)=DF3(I)                                                     KOHL
      DFK4(I)=DF4(I)                                                     KOHL
      DFF1(I)=DF1(I)                                                     KOHL
      DFF2(I)=DF2(I)                                                     KOHL
      DFF3(I)=DF3(I)                                                     KOHL
      DFF4(I)=DF4(I)                                                     KOHL
273   CONTINUE                                                           KOHL
      ZK1=ZV1+RK1                                                        KOHL
      ZK2=ZV2+RK2                                                        KOHL
      ZK3=ZV3+RK3                                                        KOHL
      ZK4=ZV4+RK4                                                        KOHL
280   CONTINUE                                                           KOHL
      DHK12=SHK12                                                        KOHL
      DHK13=SHK13                                                        KOHL
      DHK14=SHK14                                                        KOHL
      DHK32=SHK32                                                        KOHL
      DHK33=SHK33                                                        KOHL
      DHK34=SHK34                                                        KOHL
      DHK42=SHK42                                                        KOHL
      DHK43=SHK43                                                        KOHL
      DHK44=SHK44                                                        KOHL
      DEK=SEK                                                            KOHL
      DG12=-G12                                                          KOHL
      RZ1=RK1                                                            KOHL
      RZ2=RK2                                                            KOHL
      RZ3=RK3                                                            KOHL
      RZ4=RK4                                                            KOHL
      ID=1                                                               KOHL
      K1=1                                                               KOHL
      IB=1                                                               KOHL
      IF(IE)347,349,347                                                  KOHL
290   ZV1=ZV1+G3B1                                                       KOHL
      ZV2=ZV2+G3B2                                                       KOHL
      ZV3=ZV3+G3B3                                                       KOHL
      ZV4=ZV4+G3B4                                                       KOHL
      GO TO 340                                                          KOHL
295   ZV1=ZV1+G5B1                                                       KOHL
      ZV2=ZV2+G5B2                                                       KOHL
      ZV3=ZV3+G5B3                                                       KOHL
      ZV4=ZV4+G5B4                                                       KOHL
      GO TO 340                                                          KOHL
300   ZV1=ZV1+G7B1                                                       KOHL
      ZV2=ZV2+G7B2                                                       KOHL
      ZV3=ZV3+G7B3                                                       KOHL
      ZV4=ZV4+G7B4                                                       KOHL
340   RZ1=RZ1+RK1                                                        KOHL
      RZ2=RZ2+RK2                                                        KOHL
      RZ3=RZ3+RK3                                                        KOHL
      RZ4=RZ4+RK4                                                        KOHL
      ZK1=ZV1+RZ1                                                        KOHL
      ZK2=ZV2+RZ2                                                        KOHL
      ZK3=ZV3+RZ3                                                        KOHL
      ZK4=ZV4+RZ4                                                        KOHL
      DHK12=DHK12+SHK12                                                  KOHL
      DHK13=DHK13+SHK13                                                  KOHL
      DHK14=DHK14+SHK14                                                  KOHL
      DHK32=DHK32+SHK32                                                  KOHL
      DHK33=DHK33+SHK33                                                  KOHL
      DHK34=DHK34+SHK34                                                  KOHL
      DHK42=DHK42+SHK42                                                  KOHL
      DHK43=DHK43+SHK43                                                  KOHL
      DHK44=DHK44+SHK44                                                  KOHL
      DEK=DEK+SEK                                                        KOHL
      DG12=DG12-G12                                                      KOHL
      K1=IABS(K1)+1                                                      KOHL
      IF(IE)345,349,345                                                  KOHL
345   CONTINUE                                                           KOHL
      DO 346 I=1,23                                                      KOHL
      DFK1(I)=DFK1(I)+DFF1(I)                                            KOHL
      DFK2(I)=DFK2(I)+DFF2(I)                                            KOHL
      DFK3(I)=DFK3(I)+DFF3(I)                                            KOHL
      DFK4(I)=DFK4(I)+DFF4(I)                                            KOHL
346   CONTINUE                                                           KOHL
347   DO 348 I=1,23                                                      KOHL
      FK1(I)=FS1(I)+DFK1(I)                                              KOHL
      FK2(I)=FS2(I)+DFK2(I)                                              KOHL
      FK3(I)=FS3(I)+DFK3(I)                                              KOHL
      FK4(I)=FS4(I)+DFK4(I)                                              KOHL
348   CONTINUE                                                           KOHL
349   CONTINUE                                                           KOHL
      DEZK=DEZL+DEK                                                      KOHL
      DBH12=DBS12+DHK12                                                  KOHL
      DBH13=DBS13+DHK13                                                  KOHL
      DBH14=DBS14+DHK14                                                  KOHL
      DBH22=DBS22                                                        KOHL
      DBH23=DBS23                                                        KOHL
      DBH24=DBS24                                                        KOHL
      DBH32=DBS32+DHK32                                                  KOHL
      DBH33=DBS33+DHK33                                                  KOHL
      DBH34=DBS34+DHK34                                                  KOHL
      DBH42=DBS42+DHK42                                                  KOHL
      DBH43=DBS43+DHK43                                                  KOHL
      DBH44=DBS44+DHK44                                                  KOHL
      DEH=DE0H+DG12                                                      KOHL
      GO TO 370                                                          KOHL
350   CONTINUE                                                           KOHL
      IPK=-IPK                                                           KOHL
      ZK1=ZV1-RZ1                                                        KOHL
      ZK2=ZV2-RZ2                                                        KOHL
      ZK3=ZV3-RZ3                                                        KOHL
      ZK4=ZV4-RZ4                                                        KOHL
      K1=-K1                                                             KOHL
      DO 352 I=1,23                                                      KOHL
      FK1(I)=FS1(I)-DFK1(I)                                              KOHL
      FK2(I)=FS2(I)-DFK2(I)                                              KOHL
      FK3(I)=FS3(I)-DFK3(I)                                              KOHL
352   FK4(I)=FS4(I)-DFK4(I)                                              KOHL
      DBH12=DBS12-DHK12                                                  KOHL
      DBH13=DBS13-DHK13                                                  KOHL
      DBH14=DBS14-DHK14                                                  KOHL
      DBH22=DBS22                                                        KOHL
      DBH23=DBS23                                                        KOHL
      DBH24=DBS24                                                        KOHL
      DBH32=DBS32-DHK32                                                  KOHL
      DBH33=DBS33-DHK33                                                  KOHL
      DBH34=DBS34-DHK34                                                  KOHL
      DBH42=DBS42-DHK42                                                  KOHL
      DBH43=DBS43-DHK43                                                  KOHL
      DBH44=DBS44-DHK44                                                  KOHL
      DEZK=DEZL-DEK                                                      KOHL
      DEH=DE0H-DG12                                                      KOHL
370   CONTINUE                                                           KOHL
      DB12=DBH12                                                         KOHL
      DB13=DBH13                                                         KOHL
      DB14=DBH14                                                         KOHL
      DB22=DBH22                                                         KOHL
      DB23=DBH23                                                         KOHL
      DB24=DBH24                                                         KOHL
      DB32=DBH32                                                         KOHL
      DB33=DBH33                                                         KOHL
      DB34=DBH34                                                         KOHL
      DB42=DBH42                                                         KOHL
      DB43=DBH43                                                         KOHL
      DB44=DBH44                                                         KOHL
      DO 372 I=1,23                                                      KOHL
      FP1(I)=FK1(I)                                                      KOHL
      FP2(I)=FK2(I)                                                      KOHL
      FP3(I)=FK3(I)                                                      KOHL
372   FP4(I)=FK4(I)                                                      KOHL
      B1=ZK1                                                             KOHL
      B2=ZK2                                                             KOHL
      B3=ZK3                                                             KOHL
      B4=ZK4                                                             KOHL
      DEP=DEZK                                                           KOHL
      DEN=DEZK                                                           KOHL
      DELH=DEH                                                           KOHL
      NEP=0                                                              KOHL
      ID=ID+1                                                            KOHL
      IF(IE)80,375,80                                                    KOHL
375   ID=ID+1                                                            KOHL
      GO TO 80                                                           KOHL
400   CONTINUE                                                           KOHL
      IDV=0                                                              KOHL
      IE=IE+1                                                            KOHL
      IF(IE-L2)430,420,440                                               KOHL
420   IF(K2.EQ.0.AND.H2.EQ.0)GO TO 440                                   KOHL
430   CONTINUE                                                           KOHL
       LSUK=LSU+IE                                                       KOHL
      L1ZJ=IE*IZJ                                                        KOHL
      LSUH=LSUZJ+L1ZJ                                                    KOHL
      RO=RO+2.                                                           KOHL
      DBL22=RO*VM234                                                     KOHL
      DBL23=-RO*VM334                                                    KOHL
      DBL24=RO*VM434                                                     KOHL
      DBL32=-RO*VM224                                                    KOHL
      DBL33=RO*VM324                                                     KOHL
      DBL34=-RO*VM424                                                    KOHL
      DBL42=RO*VM223                                                     KOHL
      DBL43=-RO*VM323                                                    KOHL
      DBL44=RO*VM423                                                     KOHL
      ROG=RO*G11                                                         KOHL
      DEZL=DEZL+ROG                                                      KOHL
      DBK12=DBK12+VM224                                                  KOHL
      DBK13=DBK13-VM324                                                  KOHL
      DBK14=DBK14+VM424                                                  KOHL
      DBK22=DBK22-VM214                                                  KOHL
      DBK23=DBK23+VM314                                                  KOHL
      DBK24=DBK24-VM414                                                  KOHL
      DBK42=DBK42+VM212                                                  KOHL
      DBK43=DBK43-VM312                                                  KOHL
      DBK44=DBK44+VM412                                                  KOHL
      DBS12=DBS12-VM223                                                  KOHL
      DBS13=DBS13+VM323                                                  KOHL
      DBS14=DBS14-VM423                                                  KOHL
      DBS22=DBS22+VM213                                                  KOHL
      DBS23=DBS23-VM313                                                  KOHL
      DBS24=DBS24+VM413                                                  KOHL
      DBS32=DBS32-VM212                                                  KOHL
      DBS33=DBS33+VM312                                                  KOHL
      DBS34=DBS34-VM412                                                  KOHL
      DE0H=DE0H-G14                                                      KOHL
      SEK=SEK+G13                                                        KOHL
      F342=DBL23-DBL24+F342                                              KOHL
      F343=DBL33-DBL34+F343                                              KOHL
      F344=DBL43-DBL44+F344                                              KOHL
      F242=DBL22-DBL24+F242                                              KOHL
      F243=DBL32-DBL34+F243                                              KOHL
      F244=DBL42-DBL44+F244                                              KOHL
      F142=F142-DBL24                                                    KOHL
      F143=F143-DBL34                                                    KOHL
      F144=F144-DBL44                                                    KOHL
      F132=F132-DBL23                                                    KOHL
      F133=F133-DBL33                                                    KOHL
      F134=F134-DBL43                                                    KOHL
      Z2=Z2+DBL22*S2+DBL23*S3+DBL24*S4                                   KOHL
      Z3=Z3+DBL32*S2+DBL33*S3+DBL34*S4                                   KOHL
      Z4=Z4+DBL42*S2+DBL43*S3+DBL44*S4                                   KOHL
      GO TO 70                                                           KOHL
440   CONTINUE                                                           KOHL
      GO TO 1109                                                         KOHL
500   CONTINUE                                                           KOHL
      VL=A4*A5*A6-A*A5*A5-B*A6*A6                                        KOHL
      VOL=(DL*A3+VL)*0.25                                                KOHL
      IF(VOL)100,100,511                                                 KOHL
511   CONTINUE                                                           KOHL
      IF(IZE.EQ.4)VOL=4.*VOL                                             KOHL
      DO 513 I=1,JV                                                      KOHL
      IF(VOL-VG(I))512,512,513                                           KOHL
512    IF(VOL-VK(I))100,514,514                                          KOHL
513   CONTINUE                                                           KOHL
      GO TO 100                                                          KOHL
514   CONTINUE                                                           KOHL
      IF(IZE-4)509,502,509                                               KOHL
502   IF(A4)503,504,504                                                  KOHL
503   A4=-A4                                                             KOHL
      A6=-A6                                                             KOHL
504   A1=APB-A4                                                          KOHL
      A2=APB+A4                                                          KOHL
      E=A5                                                               KOHL
      IF(A2-AA4)505,505,506                                              KOHL
505   A4=DD                                                              KOHL
      A5=E+A6                                                            KOHL
      A6=E-A6                                                            KOHL
      GO TO 507                                                          KOHL
506   A2=AA4                                                             KOHL
      A4=A4+A4-AA4                                                       KOHL
      A5=A6+A6                                                           KOHL
      A6=E-A6                                                            KOHL
507   DL=4.*DL                                                           KOHL
      VL=4.*VL                                                           KOHL
509   CONTINUE                                                           KOHL
      LUF=0                                                              KOHL
      TH=-2.*A1                                                          KOHL
      TK=-2.*A2                                                          KOHL
      THK=-A4                                                            KOHL
      DO 760 IQ=7,NQ                                                     KOHL
      QQ=Q(IQ)                                                           KOHL
      FEHL=FEHLP*QQ                                                      KOHL
      QQF=QQ+FEHL                                                        KOHL
      ZZ2=QQF/(A3+VL/DL)                                                 KOHL
      IF(ZZ2-36.)519,516,516                                             KOHL
519   LMAX=SQRT(ZZ2)                                                     KOHL
      GO TO 517                                                          KOHL
516   LMAX=6                                                             KOHL
517   CONTINUE                                                           KOHL
      L=-1                                                               KOHL
524   L=L+1                                                              KOHL
      REST0= SECOND(REST)                                                KOHL
      VVL=L                                                              KOHL
      VDL=VVL/DL                                                         KOHL
      D0=QQ-A3*VVL**2                                                    KOHL
      TD0H=-A1-A6*VVL                                                    KOHL
      TD0K=-A2-A5*VVL                                                    KOHL
      HD0=0                                                              KOHL
      KD0=0                                                              KOHL
      IF(ABS(D0)-FEHL)750,750,520                                        KOHL
520   IF(D0)530,530,521                                                  KOHL
521   E0=D0+TD0H                                                         KOHL
      TE0H=TD0H+TH                                                       KOHL
      TE0K=TD0K+THK                                                      KOHL
      HE0=HD0+1                                                          KOHL
      KE0=KD0                                                            KOHL
      IF(ABS(E0)-FEHL)750,750,522                                        KOHL
522   IF(E0)540,540,523                                                  KOHL
523   D0=E0                                                              KOHL
      TD0H=TE0H                                                          KOHL
      TD0K=TE0K                                                          KOHL
      HD0=HE0                                                            KOHL
      IF(HD0-NU)521,525,525                                              KOHL
525   D1=D0                                                              KOHL
      TD1H=TD0H                                                          KOHL
      TD1K=TD0K                                                          KOHL
      HD1=HD0                                                            KOHL
      KD1=KD0                                                            KOHL
      HE1=NU                                                             KOHL
      KE1=KD1+1                                                          KOHL
      IG=1                                                               KOHL
      HE0=NU                                                             KOHL
      HD0=NU                                                             KOHL
      KE0=KD0+1                                                          KOHL
      IF(KD0.EQ.(-NU))KD0=-NUM                                           KOHL
      IF(L)605,527,605                                                   KOHL
527   HD0=-NU                                                            KOHL
      HE0=-NU                                                            KOHL
      KE0=-1                                                             KOHL
      GO TO 605                                                          KOHL
530   SHD0=(A4*A5-2.*A2*A6)*VDL                                          KOHL
      SKD0=(A4*A6-2.*A1*A5)*VDL                                          KOHL
      HD0=ABS(SHD0)+0.5                                                  KOHL
      KD0=ABS(SKD0)+0.5                                                  KOHL
      IF(SKD0.LT.0.)KD0=-KD0                                             KOHL
      IF(SHD0.LT.0.)HD0=-HD0                                             KOHL
      IF(HD0.GT.NUM)HD0=NUM                                              KOHL
      IF(HD0.LT.(-NU))HD0=-NU                                            KOHL
      IF(KD0.GT.NU)KD0=NU                                                KOHL
      IF(KD0.LT.(-NU))KD0=-NU                                            KOHL
      VH0=HD0                                                            KOHL
      VK0=KD0                                                            KOHL
      D0=D0-(A1*VH0+A4*VK0+A6*VVL)*VH0-(A2*VK0+A5*VVL)*VK0               KOHL
      IF(ABS(D0)-FEHL)750,750,531                                        KOHL
531   IF(D0)534,750,532                                                  KOHL
532   TD0H=-(2.*VH0+1.)*A1-A4*VK0-A6*VVL                                 KOHL
      TD0K=-(2.*VK0+1.)*A2-A4*VH0-A5*VVL                                 KOHL
      GO TO 521                                                          KOHL
534   IIK=1                                                              KOHL
      VK00=VK0                                                           KOHL
535   SH1=-(A4*VK0+A6*VVL)/(2.*A1)                                       KOHL
      D1=PHI(QQF,SH1,VK0)                                                KOHL
      IF(D1)539,536,536                                                  KOHL
536   HD0=SH1+100.5                                                      KOHL
      HD0=HD0-100                                                        KOHL
      VH0=HD0                                                            KOHL
      D0=PHI(QQ,VH0,VK0)                                                 KOHL
      IF(ABS(D0)-FEHL)750,750,537                                        KOHL
537   IF(D0.LE.0)GO TO 538                                               KOHL
      IF(IABS(HD0).GT.NU.OR.IABS(KD0).GT.NU)GO TO 750                    KOHL
      GO TO 532                                                          KOHL
538   VK0=VK0+IIK                                                        KOHL
      GO TO 535                                                          KOHL
539   IF(IIK.LT.0)GO TO 701                                              KOHL
      IIK=-1                                                             KOHL
      VK0=VK00-1                                                         KOHL
      GO TO 535                                                          KOHL
540   CONTINUE                                                           KOHL
      IG=1                                                               KOHL
      D1=D0                                                              KOHL
      TD1H=TD0H                                                          KOHL
      TD1K=TD0K                                                          KOHL
      HD1=HD0                                                            KOHL
      KD1=KD0                                                            KOHL
      E1=E0                                                              KOHL
      TE1H=TE0H                                                          KOHL
      TE1K=TE0K                                                          KOHL
      HE1=HE0                                                            KOHL
      KE1=KE0                                                            KOHL
      D2=E1+TE1K                                                         KOHL
      TD2H=TE1H+THK                                                      KOHL
      TD2K=TE1K+TK                                                       KOHL
      HD2=HE1                                                            KOHL
      KD2=KE1+1                                                          KOHL
      IF(L)545,542,545                                                   KOHL
542   HD0=-HD0                                                           KOHL
      KD0=-KD0                                                           KOHL
      HE0=-HE0                                                           KOHL
      KE0=-KE0                                                           KOHL
545   CONTINUE                                                           KOHL
551   CONTINUE                                                           KOHL
      REST1= SECOND(REST)                                                KOHL
      IF(REST1-REST0-0.5)548,548,690                                     KOHL
548   CONTINUE                                                           KOHL
      IF(ABS(D2)-FEHL)750,750,552                                        KOHL
552   IF(D2)570,553,553                                                  KOHL
553   D1=D2                                                              KOHL
      TD1K=TD2K                                                          KOHL
      TD1H=TD2H                                                          KOHL
      IF(IG)560,560,554                                                  KOHL
554   KD1=KD2                                                            KOHL
      IF(HD1-HE1)555,690,557                                             KOHL
555   HD1=HD2                                                            KOHL
      GO TO 600                                                          KOHL
557   HD1=HD2                                                            KOHL
      GO TO 620                                                          KOHL
560   HD1=HD2                                                            KOHL
      IF(KD1-KE1)561,690,563                                             KOHL
561   KD1=KD2                                                            KOHL
      GO TO 640                                                          KOHL
563   KD1=KD2                                                            KOHL
      GO TO 660                                                          KOHL
570   CONTINUE                                                           KOHL
      IF(IG)575,690,571                                                  KOHL
571   HE2=HD1                                                            KOHL
      KE2=KD2                                                            KOHL
      IF(KE2-KD1)572,690,573                                             KOHL
572   TE2H=TD1H-THK                                                      KOHL
      TE2K=TD1K-TK                                                       KOHL
      E2=D1-TE2K                                                         KOHL
      GO TO 580                                                          KOHL
573   E2=D1+TD1K                                                         KOHL
      TE2H=TD1H+THK                                                      KOHL
      TE2K=TD1K+TK                                                       KOHL
      GO TO 580                                                          KOHL
575   HE2=HD2                                                            KOHL
      KE2=KD1                                                            KOHL
      IF(HE2-HD1)576,690,577                                             KOHL
576   TE2H=TD1H-TH                                                       KOHL
      TE2K=TD1K-THK                                                      KOHL
      E2=D1-TE2H                                                         KOHL
      GO TO 580                                                          KOHL
577   E2=D1+TD1H                                                         KOHL
      TE2H=TD1H+TH                                                       KOHL
      TE2K=TD1K+THK                                                      KOHL
580   CONTINUE                                                           KOHL
      IF(ABS(E2).LE.FEHL)GO TO 750                                       KOHL
      IF(E2)581,690,590                                                  KOHL
581   E1=E2                                                              KOHL
      TE1H=TE2H                                                          KOHL
      TE1K=TE2K                                                          KOHL
      IF(IG)582,690,586                                                  KOHL
582   HE1=HE2                                                            KOHL
      IF(KD1-KE1)583,690,584                                             KOHL
583   KE1=KE2                                                            KOHL
      GO TO 660                                                          KOHL
584   KE1=KE2                                                            KOHL
      GO TO 640                                                          KOHL
586   KE1=KE2                                                            KOHL
      IF(HD1-HE1)587,690,588                                             KOHL
587   HE1=HE2                                                            KOHL
      GO TO 620                                                          KOHL
588   HE1=HE2                                                            KOHL
      GO TO 600                                                          KOHL
590   D1=E2                                                              KOHL
      TD1H=TE2H                                                          KOHL
      TD1K=TE2K                                                          KOHL
      HD1=HE2                                                            KOHL
      KD1=KE2                                                            KOHL
      E1=D2                                                              KOHL
      TE1H=TD2H                                                          KOHL
      TE1K=TD2K                                                          KOHL
      IG=-IG                                                             KOHL
      IF(IG)591,690,595                                                  KOHL
591   HE1=HD2                                                            KOHL
      IF(KD2-KE1)592,690,593                                             KOHL
592   KE1=KD2                                                            KOHL
      GO TO 660                                                          KOHL
593   KE1=KD2                                                            KOHL
      GO TO 640                                                          KOHL
595   KE1=KD2                                                            KOHL
      IF(HD2-HE1)596,690,597                                             KOHL
596   HE1=HD2                                                            KOHL
      GO TO 620                                                          KOHL
597   HE1=HD2                                                            KOHL
      GO TO 600                                                          KOHL
600   CONTINUE                                                           KOHL
      IF(HE1.NE.HE0)GO TO 602                                            KOHL
      IF(KE1.NE.KE0)GO TO 602                                            KOHL
      IF(KD1.NE.KD0)GO TO 602                                            KOHL
      IF(HD1-HD0)602,699,602                                             KOHL
602   CONTINUE                                                           KOHL
      D2=E1+TE1H                                                         KOHL
      TD2H=TE1H+TH                                                       KOHL
      TD2K=TE1K+THK                                                      KOHL
      HD2=HE1+1                                                          KOHL
      IF(HD2-NU)603,603,604                                              KOHL
603   KD2=KE1                                                            KOHL
      GO TO 680                                                          KOHL
604   CONTINUE                                                           KOHL
      REST1= SECOND(REST)                                                KOHL
      IF((REST1-REST0).GT.0.5)GO TO 690                                  KOHL
      IF(KD1.EQ.KD0.AND.HD1.EQ.HD0)GO TO 699                             KOHL
      IF(KD1-KE1)615,690,611                                             KOHL
611   KE1=KD1+1                                                          KOHL
      IF(HE1.NE.HE0)GO TO 612                                            KOHL
      IF(KE1-KE0)612,699,612                                             KOHL
605   KE1=KD1+1                                                          KOHL
612   IF(KE1-NU)606,606,630                                              KOHL
606   E1=D1+TD1K                                                         KOHL
      TE1K=TD1K+TK                                                       KOHL
      TE1H=TD1H+THK                                                      KOHL
      IF(HE1.NE.HD0)GO TO 607                                            KOHL
      IF(KE1-KD0)607,699,607                                             KOHL
607   IF(ABS(E1)-FEHL)750,750,608                                        KOHL
608   IF(E1)610,750,609                                                  KOHL
609   KD1=KE1                                                            KOHL
      D1=E1                                                              KOHL
      TD1K=TE1K                                                          KOHL
      TD1H=TE1H                                                          KOHL
      GO TO 605                                                          KOHL
610   IF(HD1)602,690,622                                                 KOHL
615   KE1=KD1-1                                                          KOHL
      IF(KE1+NU)630,616,616                                              KOHL
616   TE1K=TD1K-TK                                                       KOHL
      TE1H=TD1H-THK                                                      KOHL
      E1=D1-TE1K                                                         KOHL
      IF(HE1.NE.HD0)GO TO 617                                            KOHL
      IF(KE1-KD0)617,699,617                                             KOHL
617   IF(ABS(E1)-FEHL)750,750,619                                        KOHL
619   IF(E1)610,690,618                                                  KOHL
618   KD1=KE1                                                            KOHL
      D1=E1                                                              KOHL
      TD1K=TE1K                                                          KOHL
      TD1H=TE1H                                                          KOHL
      GO TO 615                                                          KOHL
620   CONTINUE                                                           KOHL
      IF(HE1.NE.HE0)GO TO 622                                            KOHL
      IF(KE1.NE.KE0)GO TO 622                                            KOHL
      IF(HD1.NE.HD0)GO TO 622                                            KOHL
      IF(KD1-KD0)622,699,622                                             KOHL
622   CONTINUE                                                           KOHL
      TD2H=TE1H-TH                                                       KOHL
      TD2K=TE1K-THK                                                      KOHL
      D2=E1-TD2H                                                         KOHL
      HD2=HE1-1                                                          KOHL
      IF(HD2+NU)604,623,623                                              KOHL
623   KD2=KE1                                                            KOHL
      GO TO 680                                                          KOHL
630   CONTINUE                                                           KOHL
      IG=-IG                                                             KOHL
      KE1=KD1                                                            KOHL
      IF(HD1)645,690,655                                                 KOHL
640   CONTINUE                                                           KOHL
      IF(HE1.NE.HE0)GO TO 642                                            KOHL
      IF(HD1.NE.HD0)GO TO 642                                            KOHL
      IF(KE1.NE.KE0)GO TO 642                                            KOHL
      IF(KD1-KD0)642,699,642                                             KOHL
642   CONTINUE                                                           KOHL
      D2=E1+TE1K                                                         KOHL
      TD2H=TE1H+THK                                                      KOHL
      TD2K=TE1K+TK                                                       KOHL
      HD2=HE1                                                            KOHL
      KD2=KE1+1                                                          KOHL
      IF(KD2-NU)680,680,644                                              KOHL
644   IF(HD1-HE1)655,690,645                                             KOHL
645   HE1=HD1+1                                                          KOHL
      IF(HE1.NE.HE0)GO TO 647                                            KOHL
      IF(KE1-KE0)647,699,647                                             KOHL
647   CONTINUE                                                           KOHL
      IF(HE1-NU)646,646,670                                              KOHL
646   E1=D1+TD1H                                                         KOHL
      TE1H=TD1H+TH                                                       KOHL
      TE1K=TD1K+THK                                                      KOHL
      IF(ABS(E1)-FEHL)750,750,648                                        KOHL
648   IF(E1)650,750,649                                                  KOHL
649   HD1=HE1                                                            KOHL
      D1=E1                                                              KOHL
      TD1H=TE1H                                                          KOHL
      TD1K=TE1K                                                          KOHL
      GO TO 645                                                          KOHL
650   IF(KD1)642,690,662                                                 KOHL
655   HE1=HD1-1                                                          KOHL
      IF(HE1+NU)670,656,656                                              KOHL
656   TE1H=TD1H-TH                                                       KOHL
      TE1K=TD1K-THK                                                      KOHL
      E1=D1-TE1H                                                         KOHL
      IF(HE1.NE.HE0)GO TO 657                                            KOHL
      IF(KE1-KE0)657,699,657                                             KOHL
657   IF(ABS(E1)-FEHL)750,750,659                                        KOHL
659   IF(E1)650,690,658                                                  KOHL
658   HD1=HE1                                                            KOHL
      D1=E1                                                              KOHL
      TD1H=TE1H                                                          KOHL
      TD1K=TE1K                                                          KOHL
      GO TO 655                                                          KOHL
660   CONTINUE                                                           KOHL
      IF(HE1.NE.HE0)GO TO 662                                            KOHL
      IF(KE1.NE.KE0)GO TO 662                                            KOHL
      IF(HD1.NE.HD0)GO TO 662                                            KOHL
      IF(KD1-KD0)662,699,662                                             KOHL
662   TD2H=TE1H-THK                                                      KOHL
      TD2K=TE1K-TK                                                       KOHL
      D2=E1-TD2K                                                         KOHL
      HD2=HE1                                                            KOHL
      KD2=KE1-1                                                          KOHL
      IF(KD2+NU)644,680,680                                              KOHL
670   IG=-IG                                                             KOHL
      HE1=HD1                                                            KOHL
      IF(KD1)605,690,615                                                 KOHL
680   IG=-IG                                                             KOHL
      GO TO 551                                                          KOHL
690   CONTINUE                                                           KOHL
      WRITE(6,3031)HD0,KD0,HE0,KE0,D0,E0,L,LMAX                          KOHL
      WRITE(6,3032)HD1,KD1,HE1,KE1,D1,E1,IG                              KOHL
      WRITE(6,3033)HD2,KD2,HE2,KE2,D2,E2,IG                              KOHL
      WRITE(6,3034)A1,A2,A3,A4,A5,A6,QQ                                  KOHL
699   CONTINUE                                                           KOHL
      IF(L.LT.LMAX)GO TO 524                                             KOHL
701   CONTINUE                                                           KOHL
      LUF=LUF+1                                                          KOHL
      IF(LUF-LUFM)750,750,101                                            KOHL
750   CONTINUE                                                           KOHL
760   CONTINUE                                                           KOHL
      IAZ=IAZ+1                                                          KOHL
      AZ(1,IAZ)=A1                                                       KOHL
      AZ(2,IAZ)=A2                                                       KOHL
      AZ(3,IAZ)=A3                                                       KOHL
      AZ(4,IAZ)=A4                                                       KOHL
      AZ(5,IAZ)=A5                                                       KOHL
      AZ(6,IAZ)=A6                                                       KOHL
      VVV(IAZ)=VOL                                                       KOHL
      IF(IAZ.EQ.500)GO TO 68                                             KOHL
      GO TO 101                                                          KOHL
1109  CONTINUE                                                           KOHL
      IF(H2)1120,1120,1115                                               KOHL
1115  H2=-H2                                                             KOHL
      GO TO 56                                                           KOHL
1119  CONTINUE                                                           KOHL
1120  CONTINUE                                                           KOHL
      IF(K2)1130,1130,1125                                               KOHL
1125  K2=-K2                                                             KOHL
      GO TO 46                                                           KOHL
1130  CONTINUE                                                           KOHL
 1139  CONTINUE                                                          KOHL
1140  CONTINUE                                                           KOHL
      IF(H3.LE.0)GO TO 1150                                              KOHL
      H3=-H3                                                             KOHL
      GO TO 36                                                           KOHL
1150  CONTINUE                                                           KOHL
      IF(K3.LE.0)GO TO 1160                                              KOHL
      K3=-K3                                                             KOHL
      GO TO 26                                                           KOHL
1160  CONTINUE                                                           KOHL
1170  CONTINUE                                                           KOHL
1180  CONTINUE                                                           KOHL
      HM4=0                                                              KOHL
1190  CONTINUE                                                           KOHL
      KM4=0                                                              KOHL
1200  CONTINUE                                                           KOHL
      ITP=1                                                              KOHL
      IF(IAZ.EQ.0)WRITE(6,3024)                                          KOHL
      CALL AMT(IAZ,6)                                                    KOHL
1300  CONTINUE                                                           KOHL
      IF(ITP.LE.0)WRITE(6,3021)H4,K4,L4,IZE                              KOHL
      IF(IZER)2000,2000,1500                                             KOHL
1500  IZE=IZE+1                                                          KOHL
      IF(WMB.GE.12..AND.NNN.GE.20)CALL EXIT                              KOHL
      IF(IZE-4)14,14,2000                                                KOHL
2000  CONTINUE                                                           KOHL
3000  FORMAT(20A4)                                                       KOHL
3001   FORMAT(//42X,26HSEARCH FOR TRICLINIC CELLS/42X,26(1H*)//)         KOHL
3002  FORMAT(1H0,28HSEARCH FOR PROPER BASE LINES/)                       KOHL
3003  FORMAT(/5H0CASE,I2,3H  (,2I1,8H0) AND (,2I1,35H0) FOR THE FIRST TW KOHL
     +O D-VALUES (IZE=,I1,1H))                                           KOHL
3004  FORMAT(1X,F15.3,6H .....,F9.3)                                     KOHL
3005  FORMAT(///,1H0,47HNUMBER OF D-VALUES USED TO VERIFY THE UNIT CELL, KOHL
     110(1H.),I3,15X,20HINPUT D-VALUES (OBS)/   34H NUMBER OF INCORRECT  KOHL
     2LINES ALLOWED,25(1H.),I2,24X,1HD,8X,3H1/D,9X,1HQ/  25H ALLOWED ERR KOHL
     3OR (QO-QC)/QO,30(1H.),F6.3)                                        KOHL
3006  FORMAT(22H NUMBER OF REFINEMENTS,37(1H.),I2)                       KOHL
3007  FORMAT(1X,23HVOLUME PER FORMULA UNIT,19(1H.),F8.3,3H +-,F7.3)      KOHL
3008  FORMAT(49H MAXIMUM NUMBER OF FORMULA UNITS PER CELL ALLOWED,       KOHL
     110(1H.),I2)                                                        KOHL
3009  FORMAT(1H0,21HINDEXING OF BASELINES/90X,7H/H/K/L/)                 KOHL
3010  FORMAT(3X,9HLINE 1   ,76(1H.),2X,2I2,2H 0/3X,9HLINE 2   ,76(1H.)   KOHL
     +,2X,2I2,2H 0)                                                      KOHL
3011  FORMAT(3X,25HLINES 3,4,5,6   WITH L=0 ,49(1H.),19H    UP TO     4  KOHL
     14 0/19X,23HWITH L GREATER THAN 0  ,35(1H.),13H    UP TO    ,3I2/19 KOHL
     2X,34HONE OF THIS LINES IS INDEXED FROM ,16(1H.),3I2,6X             KOHL
     3,5HUP TO ,4X,3I2)                                                  KOHL
3012  FORMAT(1H ,I2,48H Q-VALUES ARE PRINTED OUT IF M20 IS GREATER THAN, KOHL
     + 8(1H.),I2)                                                        KOHL
3013  FORMAT(1H+,75X,I3,F9.3,2F11.5)                                     KOHL
3014  FORMAT(///16H0INPUT PARAMETER/6H IORT=,I2,9H   IUNAB=,I2,6H  IZE=  KOHL
     +,I1,5X,4HNLM=,I1,5X,3HIM=,I1,6X,4HITA=,I1,5X,4HHM4=,I1,5X,4HKM4=   KOHL
     +,I1,5X,4HLM4=,I1,5X,6HH4MAX=,I1,9H   K4MAX=,I1,9H   L4MAX=,I1)     KOHL
3015  FORMAT(1H ,75X,I3,F9.3,2F11.5)                                     KOHL
3016  FORMAT(1X,4HMOM=,I3,9H   ITEST=,I2,7H  TILI=,F8.2,7X,4HI20=,F4.1,  KOHL
     1  7H  IMON=,I2)                                                    KOHL
3017  FORMAT(1H  ,10HWAVELENGTH,40(1H.))                                 KOHL-CO
3018  FORMAT(1H+,50X,F10.6)                                              KOHL-CO
3020  FORMAT(1H1,20A4)                                                   KOHL
3021  FORMAT(//62H0CALCULATION NOT FINISHED.CONTINUE WITH IMPUT PARAMETE KOHL
     +RS  HM4=,I1,6H, KM4=,I1,6H, LM4=,I1,10H, AND IZE=,I1,16H, IF NO SO KOHL
     +LUTION/42H OR NO ACCEPTABLE SOLUTION IS PRINTED OUT.)              KOHL
3022  FORMAT(1H0,14HVOLUME RANGES )                                      KOHL
3023  FORMAT(1H0,29HREMAINING JOBTIME IN SECONDS ,I10/)                  KOHL
3024  FORMAT(1H0,' NO SOLUTION FOUND')                                   KOHL
3031  FORMAT(1X,4HHD0=,I2,5X,4HKD0=,I2,5X,4HHE0=,I2,5X,4HKE0=,I2,10X,    KOHL
     13HD0=,E14.5,5X,3HE0=,E14.5,10X,2HL=,I2,5X,5HLMAX=,I2)              KOHL
3032  FORMAT(1X,4HHD1=,I2,5X,4HKD1=,I2,5X,4HHE1=,I2,5X,4HKE1=,I2,10X,    KOHL
     13HD1=,E14.5,5X,3HE1=,E14.5,10X,3HIG=,I2)                           KOHL
3033  FORMAT(1X,4HHD2=,I2,5X,4HKD2=,I2,5X,4HHE2=,I2,5X,4HKE2=,I2,10X,    KOHL
     13HD2=,E14.5,5X,3HE2=,E14.5,10X,3HIG=,I2)                           KOHL
3034  FORMAT(1H0,3G15.5,2X,3G15.5,5X,3HQQ=,F10.6)                        KOHL
3060  FORMAT(1X,4HIZA=,I9,10X,4HIZB=,I8,10X,4HIZC=,I5)                   KOHL
      CALL EXIT                                                          KOHL
      END                                                                KOHL
      SUBROUTINE AMT(IAZ,IOR)                                            KOHL
      DIMENSION AZ(6,500),VVV(500),AR(9)                                 KOHL
      COMMON /LSG/AZ,VVV                                                 KOHL
      IF(IAZ.LE.0)RETURN                                                 KOHL-CO
      IF(IAZ.LE.0)RETURN                                                 KOHL-1
      IF(IOR-3)2,2,4                                                     KOHL
2     DO 3 I=1,IAZ                                                       KOHL
      A1=AMIN1(AZ(1,I),AZ(2,I))                                          KOHL
      A2=AMAX1(AZ(1,I),AZ(2,I))                                          KOHL
      A3=AMAX1(A1,AZ(3,I))                                               KOHL
      AZ(1,I)=AMIN1(A1,AZ(3,I))                                          KOHL
      AZ(2,I)=AMIN1(A2,A3)                                               KOHL
      AZ(3,I)=AMAX1(A2,A3)                                               KOHL
3     CONTINUE                                                           KOHL
      GO TO 10                                                           KOHL
4     CONTINUE                                                           KOHL
      DO 5 I=1,IAZ                                                       KOHL
      A1=AZ(1,I)                                                         KOHL
      A2=AZ(2,I)                                                         KOHL
      A3=AZ(3,I)                                                         KOHL
      A4=AZ(4,I)                                                         KOHL
      A5=AZ(5,I)                                                         KOHL
      A6=AZ(6,I)                                                         KOHL
      CALL REZE(A1,A2,A3,A4,A5,A6,AR,VOL,1)                              KOHL
      AZ(1,I)=A1                                                         KOHL
      AZ(2,I)=A2                                                         KOHL
      AZ(3,I)=A3                                                         KOHL
      AZ(4,I)=A4                                                         KOHL
      AZ(5,I)=A5                                                         KOHL
5     AZ(6,I)=A6                                                         KOHL
10    IAM=1                                                              KOHL
      CALL SORT7(IAZ,VVV,AZ,500,6)                                       KOHL
      IDA=1                                                              KOHL
      VFF=A2*0.0001                                                      KOHL
      IF(IOR.EQ.3)VFF=VFF*50.                                            KOHL
      IAZM=IAZ-1                                                         KOHL
      DO 60 ID=1,IAZM                                                    KOHL
      I=ID+1                                                             KOHL
      DO 50 J=1,6                                                        KOHL
      IF(ABS(AZ(J,ID)-AZ(J,I))-VFF)50,50,55                              KOHL
50    CONTINUE                                                           KOHL
      GO TO 60                                                           KOHL
55    DO 56 J=1,6                                                        KOHL
56    AZ(J,IDA)=AZ(J,ID)                                                 KOHL
      VVV(IDA)=VVV(ID)                                                   KOHL
      IDA=IDA+1                                                          KOHL
60    CONTINUE                                                           KOHL
      DO 63 J=1,6                                                        KOHL
63    AZ(J,IDA)=AZ(J,IAZ)                                                KOHL
      VVV(IDA)=VVV(IAZ)                                                  KOHL
      CALL VERG(IDA,IOR)                                                 KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      FUNCTION ARCOS(X)                                                  KOHL
      ARCOS=ACOS(X)                                                      KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      BLOCK DATA                                                         KOHL
      COMMON/QUAD/IG                                                     KOHL
      DIMENSION IG(84)                                                   KOHL
      DATA IG/-1,0,1,1,1,5*4,7*9,9*16,11*25,13*36,15*49,17*64,81,81/     KOHL
      END                                                                KOHL
      SUBROUTINE  GLG(A,M,N,IR,INV,LU,DELTA,IRO)                         KOHL
      DIMENSION A(6,7)  ,JF(50),IB(50),IL(50),IG(50)                     KOHL
      NR=N+IR                                                            KOHL
      DELTA =1.                                                          KOHL
      IRO = 0                                                            KOHL
      DO 3 I=1,M                                                         KOHL
      JF(I)= 0                                                           KOHL
      IB(I)= 0                                                           KOHL
      IL(I)= I                                                           KOHL
    3 IG(I)= I                                                           KOHL
      K = 1                                                              KOHL
      IQ1 = 0                                                            KOHL
    6 W = 0.                                                             KOHL
      IQ1 = IQ1 + 1                                                      KOHL
      DO 10 I=1,M                                                        KOHL
      IF(IB(I))  8,8,10                                                  KOHL
    8 IF(ABS(A(I,IQ1))-ABS(W))10,10,9                                    KOHL
    9 W = A(I,IQ1)                                                       KOHL
      IPHI = I                                                           KOHL
   10 CONTINUE                                                           KOHL
      IF(W) 13,14,13                                                     KOHL
   14 IF(LU) 15,15,16                                                    KOHL
15    CONTINUE                                                           KOHL
      DELTA=0.                                                           KOHL
      GO TO 60                                                           KOHL
   16 IF(IQ1-N) 6,40,6                                                   KOHL
   13 DELTA = W*DELTA                                                    KOHL
      IRO = IRO+1                                                        KOHL
      JF(K)=IPHI                                                         KOHL
      IB(IPHI)=1                                                         KOHL
      A(IPHI,IQ1) = 1./W                                                 KOHL
      DO 21 I= 1,M                                                       KOHL
      IF(I-IPHI) 20,21,20                                                KOHL
   20 A(I,IQ1)= -A(I,IQ1)/W                                              KOHL
   21 CONTINUE                                                           KOHL
      IF(IQ1-1) 24,26,24                                                 KOHL
   24 IF(INV) 26,26,25                                                   KOHL
   25 J1= 1                                                              KOHL
      JMAX = IQ1-1                                                       KOHL
      GO TO  27                                                          KOHL
   26 J1= IQ1+1                                                          KOHL
      JMAX = NR                                                          KOHL
   27 DO 34 J= J1,JMAX                                                   KOHL
      IF(A(IPHI,J)) 28,34,28                                             KOHL
   28 ALPHA = A(IPHI,J)                                                  KOHL
      A(IPHI,J) = ALPHA/W                                                KOHL
      DO 32 I= 1,M                                                       KOHL
      IF(I-IPHI) 31,32,31                                                KOHL
   31 A(I,J)= A(I,J)+ALPHA*A(I,IQ1)                                      KOHL
   32 CONTINUE                                                           KOHL
   34 CONTINUE                                                           KOHL
      IF(JMAX-NR) 37,38,37                                               KOHL
   37 IF(IQ1+1-NR) 26,26,38                                              KOHL
   38 IF(M-K) 39,40,39                                                   KOHL
   39 K=K+1                                                              KOHL
      GO TO 6                                                            KOHL
   40 I=M-1                                                              KOHL
      DO 48 K=1,I                                                        KOHL
      IF(IG(K)-JF(K)) 42,48,42                                           KOHL
   42 LAM    = JF(K)                                                     KOHL
      LAM    = IL(LAM)                                                   KOHL
      DO 43 J=1,NR                                                       KOHL
      W= A(K,J)                                                          KOHL
      A(K,J)= A(LAM,J)                                                   KOHL
   43 A(LAM,J) = W                                                       KOHL
      DELTA = -DELTA                                                     KOHL
      J1 = JF(K)                                                         KOHL
      JMAX=IG(K)                                                         KOHL
      IF(INV) 47,47,46                                                   KOHL
   46 DO 49 J=1,M                                                        KOHL
      W= A(J,J1)                                                         KOHL
      A(J,J1)=A(J,JMAX)                                                  KOHL
   49 A(J,JMAX)= W                                                       KOHL
   47 IL(J1)= K                                                          KOHL
      IL(JMAX)= LAM                                                      KOHL
      IG(LAM)=IG(K)                                                      KOHL
      IG(K) = JF(K)                                                      KOHL
   48 CONTINUE                                                           KOHL
60    CONTINUE                                                           KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE ITO(Q,NE,NAB,MEN,FEHLP,DX,R,MZ,IQX,IZE,VKL,ITA)         KOHL
        DIMENSION Q(50),AL(6),AT(6),AS(6),R(500),AJ(5),IH(200),QP(200)   KOHL
     1,DX(100),IQ(200),IQX(100,12),ALL(6),ATT(6),ASS(6)                  KOHL
     1,IND1(18,2),IND2(12),DR(200),LSL(10)                               KOHL
      COMMON/LSG/AZ(6,500),VVV(500)                                      KOHL
      EQUIVALENCE (AZ(1),IH(1)),(AZ(201),QP(1)),                         KOHL
     1(AZ(501),IQ(1)),(AZ(701),DR(1))                                    KOHL
      DATA AL/0.75,1.33333333,0.41666666,1.875,0.75,0.29166666/          KOHL
      DATA AT/1.25,1.66666666,1.08333333,2.125,1.25,1.04166666/          KOHL
      DATA AS/0.5,0.33333333,0.16666666,0.25,0.125,0.08333333/           KOHL
      DATA ALL/1.3333333,2.4,0.75,0.53333333,1.3333333,0.41666666/       KOHL
      DATA ATT/1.66666666,2.6,1.25,1.1333333,1.6666666,1.0833333/        KOHL
      DATA ASS/0.33333333,0.2,0.125,0.066666666,0.083333333,0.041666666/ KOHL
      DATA IND1/1,2,3,4,5,6,2,3,3,4,4,4,1,1,2,1,2,3,1,2,3,4,5,6,1,1,2,1, KOHL
     12,3,2,3,3,4,4,4/                                                   KOHL
      DATA IND2/3,5,4,5,6,6,1,1,2,3,2,4/                                 KOHL
      DATA AJ/1.,0.25,0.1111111,0.0625,0.04/                             KOHL
      IF(IZE-4)4,5,5                                                     KOHL
4     CONTINUE                                                           KOHL
      LGR=MEN                                                            KOHL
      GO TO 7                                                            KOHL
5     DO 6 I=1,6                                                         KOHL
      J=I+6                                                              KOHL
      K=I+12                                                             KOHL
      IND1(J,1)=IND2(I)                                                  KOHL
      IND1(J,2)=IND2(J)                                                  KOHL
      IND1(K,1)=IND2(J)                                                  KOHL
      IND1(K,2)=IND2(I)                                                  KOHL
      AL(I)=ALL(I)                                                       KOHL
      AT(I)=ATT(I)                                                       KOHL
6     AS(I)=ASS(I)                                                       KOHL
      LGR=5                                                              KOHL
7     CONTINUE                                                           KOHL
      INA=0                                                              KOHL
      A=Q(1)                                                             KOHL
      B=Q(2)                                                             KOHL
      ETA=FEHLP                                                          KOHL
      DEMI2=VKL/B                                                        KOHL
      DEMI3=VKL/A                                                        KOHL
      DIF2=Q(1)*Q(3)-DEMI2                                               KOHL
      DIF3=Q(2)*Q(3)-DEMI3                                               KOHL
      MENK=MEN*(MEN-1)/2                                                 KOHL
      MEX=MEN**2*NE                                                      KOHL
      IS=3                                                               KOHL
      MZ=0                                                               KOHL
      JADE=1                                                             KOHL
      WAB2=2.0*SQRT(A*B)                                                 KOHL
10    CONTINUE                                                           KOHL
      AB=A*B                                                             KOHL
      ALU=A+B                                                            KOHL
      ALI=B-A                                                            KOHL
      R(1)=0.                                                            KOHL
C                                                                        KOHL
      MV=1                                                               KOHL
      J=1                                                                KOHL
      DO 20 I=IS,NE                                                      KOHL
      QI=Q(I)                                                            KOHL
      RR=ABS(QI-ALU)                                                     KOHL
      IF(RR-WAB2)14,14,16                                                KOHL
14    J=J+1                                                              KOHL
      R(J)=RR                                                            KOHL
      DR(J)=QI*ETA                                                       KOHL
      QP(J)=QI                                                           KOHL
      IQ(J)=I                                                            KOHL
      IH(J)=1                                                            KOHL
16    DO 20 L=2,LGR                                                      KOHL
      RR=ABS(QI*AJ(L)-ALU)                                               KOHL
      IF(RR-WAB2)18,18,20                                                KOHL
18    J=J+1                                                              KOHL
      R(J)=RR                                                            KOHL
      DR(J)=QI*AJ(L)*ETA                                                 KOHL
      QP(J)=QI                                                           KOHL
      IQ(J)=I                                                            KOHL
      IH(J)=L                                                            KOHL
20    CONTINUE                                                           KOHL
      DO 31 L=1,MENK                                                     KOHL
      AL1=ALU*AT(L)                                                      KOHL
      AL2=ALI*AL(L)                                                      KOHL
      ALS=AL1+AL2                                                        KOHL
      ALT=AL1-AL2                                                        KOHL
      LL=6+L                                                             KOHL
      DO 30 I=IS,NE                                                      KOHL
      QAS=Q(I)*AS(L)                                                     KOHL
      RR=ABS(QAS-ALS)                                                    KOHL
      IF(RR-WAB2)24,24,25                                                KOHL
24    J=J+1                                                              KOHL
      R(J)=RR                                                            KOHL
      QP(J)=Q(I)                                                         KOHL
      DR(J)=QAS*ETA                                                      KOHL
      IQ(J)=I                                                            KOHL
      IH(J)=6+LL                                                         KOHL
25    RR=ABS(QAS-ALT)                                                    KOHL
      IF(RR-WAB2)26,26,30                                                KOHL
26    J=J+1                                                              KOHL
      R(J)=RR                                                            KOHL
      DR(J)=QAS*ETA                                                      KOHL
      QP(J)=Q(I)                                                         KOHL
      IQ(J)=I                                                            KOHL
      IH(J)=LL                                                           KOHL
30    CONTINUE                                                           KOHL
31    CONTINUE                                                           KOHL
      JH=J-1                                                             KOHL
      NB=1                                                               KOHL
      DO 32 L=2,JH                                                       KOHL
      IF(R(L).LT.B)NB=NB+1                                               KOHL
32    CONTINUE                                                           KOHL
      DO 40 L=2,JH                                                       KOHL
      IF(R(L).LE.R(L+1))GO TO 40                                         KOHL
      I=L+1                                                              KOHL
35    TT=R(I)                                                            KOHL
      IT=IH(I)                                                           KOHL
      QT=QP(I)                                                           KOHL
      IIQ=IQ(I)                                                          KOHL
      DRI=DR(I)                                                          KOHL
      II=I-1                                                             KOHL
      R(I)=R(II)                                                         KOHL
      IH(I)=IH(II)                                                       KOHL
      QP(I)=QP(II)                                                       KOHL
      IQ(I)=IQ(II)                                                       KOHL
      DR(I)=DR(II)                                                       KOHL
      R(II)=TT                                                           KOHL
      IH(II)=IT                                                          KOHL
      QP(II)=QT                                                          KOHL
      IQ(II)=IIQ                                                         KOHL
      DR(II)=DRI                                                         KOHL
      I=II                                                               KOHL
      IF(R(I)-R(I-1))35,40,40                                            KOHL
40    CONTINUE                                                           KOHL
      BN=NB                                                              KOHL
      RMAX=R(J)                                                          KOHL
      IF(RMAX.LE.B)GO TO 43                                              KOHL
      RO=BN/B                                                            KOHL
      IF((RMAX*0.9).LT.B)GO TO 44                                        KOHL
      BNJ=J-NB                                                           KOHL
      RMB=RMAX-B                                                         KOHL
      ER1=BNJ-RMB*RO                                                     KOHL
      IF(ER1.LE.0)GO TO 44                                               KOHL
      RK1=2.*ER1/RMB**2                                                  KOHL
      RK0=RO-RK1*B                                                       KOHL
      LR=1                                                               KOHL
      GO TO 45                                                           KOHL
43    RO=FLOAT(J)/RMAX                                                   KOHL
44    LR=0                                                               KOHL
45    CONTINUE                                                           KOHL
      IF(ITA.EQ.0)GO TO 102                                              KOHL
      WRITE(6,203)A,B                                                    KOHL
      WRITE(6,204)                                                       KOHL
102   CONTINUE                                                           KOHL
      KM=2                                                               KOHL
      DO 60 L=2,JH                                                       KOHL
      IH1=IH(L)                                                          KOHL
      M1=IND1(IH1,1)                                                     KOHL
      N1=IND1(IH1,2)                                                     KOHL
      IF(ITA.EQ.0)GO TO 103                                              KOHL
      WRITE(6,209)L,R(L),QP(L),IQ(L),DR(L),M1,N1                         KOHL
103   CONTINUE                                                           KOHL
      K=L+1                                                              KOHL
      KN=2                                                               KOHL
      IF(IQ(L).EQ.IQ(K))GO TO 60                                         KOHL
      IF(KM-K)106,106,105                                                KOHL
105   IF(KM.GT.J)GO TO 60                                                KOHL
      K=KM                                                               KOHL
      I3=L+2                                                             KOHL
      GO TO 110                                                          KOHL
106   I3=K                                                               KOHL
110   KM=K                                                               KOHL
46    CONTINUE                                                           KOHL
      IF(R(L)-R(K)+DR(L)+DR(K))49,49,47                                  KOHL
47    CONTINUE                                                           KOHL
      IF(K-L-1)126,126,115                                               KOHL
115   DO 125 I1=I3,K                                                     KOHL
      I2=I1-1                                                            KOHL
      DO 120 I=L,I2                                                      KOHL
      IF(IQ(I)-IQ(I1))120,125,120                                        KOHL
120   CONTINUE                                                           KOHL
      KN=KN+1                                                            KOHL
      LSL(KN)=I1                                                         KOHL
125   CONTINUE                                                           KOHL
126   K=K+1                                                              KOHL
      I3=K                                                               KOHL
      IF(K-J)46,46,50                                                    KOHL
49    IF(K-KM)60,60,50                                                   KOHL
50    KM=K                                                               KOHL
      KR=KM-L                                                            KOHL
      IL=L-1                                                             KOHL
      IF(IS.NE.3)GO TO 55                                                KOHL
      DO 54  I1=3,NE                                                     KOHL
      DO 51 I=1,KR                                                       KOHL
      IF(I1-IQ(IL+I))51,54,51                                            KOHL
51    CONTINUE                                                           KOHL
      FD=A*B-VKL/Q(I1)                                                   KOHL
      IF(FD)52,53,53                                                     KOHL
52    JADE=-1                                                            KOHL
      GO TO 60                                                           KOHL
53    RHST=2.*SQRT(FD)                                                   KOHL
      IF(R(L)-RHST)55,55,60                                              KOHL
54    CONTINUE                                                           KOHL
55    MZ=MZ+1                                                            KOHL
      IQX(MZ,1)=IQ(L)                                                    KOHL
      IQX(MZ,2)=IQ(L+1)                                                  KOHL
      IF(KN-2)60,130,135                                                 KOHL
130   DBR=DR(L)+DR(L+1)                                                  KOHL
      GO TO 140                                                          KOHL
135   DO 138 I=3,KN                                                      KOHL
      IP=LSL(I)                                                          KOHL
138   IQX(MZ,I)=IQ(IP)                                                   KOHL
      DBR=R(IP)-R(L)                                                     KOHL
140   CONTINUE                                                           KOHL
      IF(LR)56,56,57                                                     KOHL
56    DX(MZ)=FLOAT(KN)/(RO*DBR+1.)                                       KOHL
      GO TO 58                                                           KOHL
57    IF(R(L).LE.B)GO TO 56                                              KOHL
      DX(MZ)=FLOAT(KN)/((RK1*R(L)+RK0)*DBR+1.)                           KOHL
58    CONTINUE                                                           KOHL
      IQX(MZ,KN+1)=0                                                     KOHL
      IF(ITA.EQ.0)GO TO 60                                               KOHL
      WRITE(6,205)DX(MZ),KR,KN                                           KOHL
60    CONTINUE                                                           KOHL
      IF(NAB-3)80,65,65                                                  KOHL
65    INA=INA+1                                                          KOHL
      IF(INA-2)66,68,80                                                  KOHL
66    B=Q(3)                                                             KOHL
      IF(JADE.GT.0)GO TO 67                                              KOHL
      IF(MZ.GT.0)GO TO 80                                                KOHL
      WRITE(6,202)                                                       KOHL
      CALL EXIT                                                          KOHL
67    CONTINUE                                                           KOHL
      IF(DIF2.LT.0.)GO TO 80                                             KOHL
      WAB2=2.*SQRT(DIF2)                                                 KOHL
      IS=4                                                               KOHL
      GO TO 10                                                           KOHL
68    A=Q(2)                                                             KOHL
      IF(DIF3.LT.0.)GO TO 80                                             KOHL
      WAB2=2.*SQRT(DIF3)                                                 KOHL
      GO TO 10                                                           KOHL
80    CONTINUE                                                           KOHL
202   FORMAT(1H0,10X,20HNO SOLUTION POSSIBLE /11X,22(1H*)///)            KOHL
203   FORMAT(1H0,/15X,2HA=,F10.5,10X,2HB=,F10.5)                         KOHL
204   FORMAT('  L ',9X,'R(L)',11X,'QP(L)',5X,'IQ',10X,'DR(L)',9X,'M  N'  KOHL
     1,7X,'DX',10X,'KR  KN')                                             KOHL
205   FORMAT(1H+,66X,F13.4,I8,I4)                                        KOHL
209   FORMAT(1X,I3,2F15.6,I6,F15.6,I10,I3)                               KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE MAUS(S,F,M,N,AK,AKM,VT1,AM)                             KOHL
      DIMENSION F(50,6),S(50),A(6,7  ),AK(6),AKM(6),B(50),VT(100)        KOHL
      DO 3 I=1,M                                                         KOHL
3     B(I)=0                                                             KOHL
      DO 5 J=1,M                                                         KOHL
      DO 5 I=1,N                                                         KOHL
5     B(J)=B(J)+S(I)*F(I,J)                                              KOHL
      DO 7 J=1,M                                                         KOHL
      DO 7 I=1,M                                                         KOHL
7     A(I,J)=0                                                           KOHL
      DO 10 K=2,M                                                        KOHL
      KMIN=K-1                                                           KOHL
      DO 10 J=1,KMIN                                                     KOHL
      DO 9 I=1,N                                                         KOHL
9     A(J,K)=A(J,K)+F(I,J)*F(I,K)                                        KOHL
10    A(K,J)=A(J,K)                                                      KOHL
      DO 11 J=1,M                                                        KOHL
      DO 11 I=1,N                                                        KOHL
11    A(J,J)=A(J,J)+F(I,J)**2                                            KOHL
      CALL GLG(A,M,M,0,1,LU,DELTA,IRO)                                   KOHL
      IF(ABS(DELTA)-0.5)16,16,17                                         KOHL
16    N=-1                                                               KOHL
      GO TO 36                                                           KOHL
17    CONTINUE                                                           KOHL
      DO 20 J=1,M                                                        KOHL
      IF(A(J,J))16,20,20                                                 KOHL
20    CONTINUE                                                           KOHL
      DO 24 J=1,6                                                        KOHL
24    AK(J)=0.                                                           KOHL
      DO 26 J=1,M                                                        KOHL
      AK(J)=0.                                                           KOHL
      DO 26 K=1,M                                                        KOHL
26    AK(J)=AK(J)+A(J,K)*B(K)                                            KOHL
      VT1=0.                                                             KOHL
      VT2=0.                                                             KOHL
      DO 30 J=1,N                                                        KOHL
      VT(J)=0.                                                           KOHL
      DO 29 I=1,M                                                        KOHL
29    VT(J)=VT(J)+AK(I)*F(J,I)                                           KOHL
      VT(J)=S(J)-VT(J)                                                   KOHL
      VT1=VT1+VT(J)                                                      KOHL
30    VT2=VT2+VT(J)**2                                                   KOHL
      ZN=N-M                                                             KOHL
      AM=SQRT(VT2/ZN)                                                    KOHL
      DO 34 J=1,M                                                        KOHL
34    AKM(J)=AM*SQRT(ABS(A(J,J)))                                        KOHL
36    CONTINUE                                                           KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE MONO (V1Z,VD1Z,NZMAX,NQ,MOM,IUNAB,QN)                   KOHL
      INTEGER HDMA,HPA                                                   KOHL
      INTEGER H,HA,HB,HC,HD,H3M,H4M,HD1,HC1,H3MM                         KOHL
      COMMON FEL(50),Q     ,NNN,LUFM,FEHLP,ITER                          KOHL
      COMMON /LSG/AZ(6,500),VVV(500)                                     KOHL
      COMMON /ZEIT/TILL                                                  KOHL
      COMMON /QUAD/IG                                                    KOHL
      COMMON /BEST/WMB                                                   KOHL
      DIMENSION Q(50),P(17),PI(5),IG(84),VG(10),VK(10)                   KOHL
      DATA P/0.,1.,4.,9.,16.,25.,36.,49.,64.,81.,100.,121.,144.,         KOHL
     +   169.,196.,225.,256./                                            KOHL
      DATA PI/1.,0.25,0.111111111,0.0625,0.04/                           KOHL
      DATA H3M,K3M,L3M,H4M,K4M,L4M/6*3/                                  KOHL
      DATA AU3/0./                                                       KOHL-2
      MOM=MOM+1                                                          KOHL
      WMB=0                                                              KOHL
      IRUN=0                                                             KOHL
      IZA=0                                                              KOHL
      IZB=0                                                              KOHL
      IZC=0                                                              KOHL
      WRITE(6,2000)                                                      KOHL
C     SUCHE NACH GEIGNETEN Q-WERTEN FUER DIE SYSTEMMATRIX                KOHL
      FEHL=FEHLP*1.5                                                     KOHL
      IF(IUNAB.LE.0)GO TO 20                                             KOHL
10    CONTINUE                                                           KOHL
      CALL UNMON(Q,FEHL,W,IRUN)                                          KOHL
      CALL SORT1(NQ,Q,50,5)                                              KOHL
      WRITE(6,2001)(Q(I),I=1,4),W                                        KOHL
20    CONTINUE                                                           KOHL
      Q1=Q(1)                                                            KOHL
      Q2=Q(2)                                                            KOHL
      Q3=Q(3)                                                            KOHL
      Q4=Q(4)                                                            KOHL
      JAZ=0                                                              KOHL
      N20=MIN0(NNN,20)                                                   KOHL
      NZMI=1                                                             KOHL
      VMI=1./SQRT(Q1*Q2*Q4)                                              KOHL
      CALL VGR(QN,V1Z,VD1Z,NZMAX,VMI,FEHLP,4,VK,VG,JV)                   KOHL
      IF(MOM)51,51,50                                                    KOHL
50    H3M=MOM                                                            KOHL
      K3M=MOM                                                            KOHL
      L3M=MOM                                                            KOHL
      H4M=MOM+1                                                          KOHL
      K4M=MOM                                                            KOHL
      L4M=MOM                                                            KOHL
51    CONTINUE                                                           KOHL
      HPA=3                                                              KOHL
C     BEREITSTELLUNG DER PARAMETER H3,K3,L3,H4,K4,L4                     KOHL
      M4=H4M                                                             KOHL
      M3=H3M                                                             KOHL
      KC1=2                                                              KOHL
      HD1=2                                                              KOHL
      HC1=1                                                              KOHL
      N4=K4M                                                             KOHL
      N3=K3M                                                             KOHL
      LL=1                                                               KOHL
      JA=1                                                               KOHL
      JB=1                                                               KOHL
100   DO 1050 LA=1,L4M                                                   KOHL
      T4=P(LA)                                                           KOHL
      DO 1040 KA=1,N4                                                    KOHL
      S4=P(KA)                                                           KOHL
      IF(LL.EQ.2)JA=2-MOD(KA,2)                                          KOHL
      DO 1030 HA=JA,M4,LL                                                KOHL
      R4=P(HA)                                                           KOHL
      RS4=(HA-1)*(KA-1)                                                  KOHL
      H3MM=M3+1                                                          KOHL
      DO 1020 LB=1,L3M                                                   KOHL
      T3=P(LB)                                                           KOHL
      IF(LB.NE.1)H3MM=H3M                                                KOHL
      TRZ2=SECOND(TTZZ)                                                  KOHL
      IF(TRZ2.GT.TILL)GO TO 1270                                         KOHL
C     BERECHNUNG FUER     K1=K2=0  MIT TAUSCH Q1 GEGEN Q2                KOHL
      IF(RS4.LT.0.1)GO TO 320                                            KOHL
      RS4I=1./RS4                                                        KOHL
      GD=R4*RS4I                                                         KOHL
      DO 315 KB=LL,N3,LL                                                 KOHL
      QQ1=Q1                                                             KOHL
      QQ2=Q2                                                             KOHL
      Q3IK=Q3*PI(KB)                                                     KOHL
      G5=(Q4-Q3IK*S4)*RS4I                                               KOHL
      T3IK=T3*PI(KB)                                                     KOHL
      G7=(T4-T3IK*S4)*RS4I                                               KOHL
      DO 310 JE=1,2                                                      KOHL
      DO 308 LC=1,3                                                      KOHL
      LC1=LC+1                                                           KOHL
      TC=LC*LC                                                           KOHL
      GA=TC*QQ1                                                          KOHL
      G8=QQ2*PI(LC)                                                      KOHL
      GX=G5-G8*G7                                                        KOHL
      DO 306 HC=1,HPA,LL                                                 KOHL
      G9=P(HC)*PI(LC)                                                    KOHL
      GY=GD-G9*G7                                                        KOHL
      DO 304 LD=1,LC1                                                    KOHL
      GE=P(HC)*P(LD)                                                     KOHL
      GB=GA-P(LD)*QQ2                                                    KOHL
      HDMA=HPA                                                           KOHL
      IF(LD.EQ.LC1)HDMA=HC-1                                             KOHL
      DO 302 HD=1,HDMA,LL                                                KOHL
      DET=P(HD)*TC-GE                                                    KOHL
       IF(ABS(DET).LT.0.1)GO TO 302                                      KOHL
      A=GB/DET                                                           KOHL
      IF(A.LE.0.)GO TO 302                                               KOHL
      C=G8-A*G9                                                          KOHL
      IF(C.LE.0.)GO TO 302                                               KOHL
      B=Q3IK-C*T3IK                                                      KOHL
      IF(B.LE.0.)GO TO 302                                               KOHL
      D=GX-A*GY                                                          KOHL
      IZA=IZA+1                                                          KOHL
      JS=1                                                               KOHL
      GO TO 1080                                                         KOHL
299   CONTINUE                                                           KOHL
302   CONTINUE                                                           KOHL
304   CONTINUE                                                           KOHL
306   CONTINUE                                                           KOHL
308   CONTINUE                                                           KOHL
      QQ1=Q2                                                             KOHL
      QQ2=Q1                                                             KOHL
310   CONTINUE                                                           KOHL
315   CONTINUE                                                           KOHL
320   CONTINUE                                                           KOHL
C     BERECHNUNG FUER BELIEBIGES L1, MIT  K1=H2=0.                       KOHL
      DO 1010 KB=1,N3                                                    KOHL
      S3=P(KB)                                                           KOHL
      IF(LL.EQ.2)JB=2-MOD(KB,2)                                          KOHL
      DO 1000 HB=JB,H3MM,LL                                              KOHL
      IF(LB.GE.LA.AND.KB.GE.KA.AND.HB.GE.HA)GO TO 1010                   KOHL
      R3=P(HB)                                                           KOHL
      RS3=(HB-1)*(KB-1)                                                  KOHL
110   CONTINUE                                                           KOHL
      DEBD=RS4*S3-S4*RS3                                                 KOHL
      G34=T3*RS4-T4*RS3                                                  KOHL
      G24=-DEBD                                                          KOHL
      G14=-R3*RS4+R4*RS3                                                 KOHL
      G23=S3*T4-S4*T3                                                    KOHL
      G13=R3*T4-R4*T3                                                    KOHL
      G12=R3*S4-R4*S3                                                    KOHL
C     STARTWERTE MIT FESTEM  K2,L2,H1,L1     (NUR WERTE  0 ODER 1).      KOHL
C                  K2=H1=1, L2=L1=0.                                     KOHL
      IF(ABS(G34).LT.0.5)GO TO 400                                       KOHL
      Y1=Q3-Q1*R3-Q2*S3                                                  KOHL
      Y2=Q4-Q1*R4-Q2*S4                                                  KOHL
      AU1=Q1                                                             KOHL
      AU2=Q2                                                             KOHL
      AU3=(RS4*Y1-RS3*Y2)/G34                                            KOHL
      AU4=(-T4*Y1+T3*Y2)/G34                                             KOHL
      JJ=1                                                               KOHL
      IF(ABS(G14).LT.0.5)GO TO 410                                       KOHL
      GO TO 407                                                          KOHL
C                  K2=L1=0, L2=H1=1.                                     KOHL
400   CONTINUE                                                           KOHL
      IF(ABS(G24).LT.0.5)GO TO 405                                       KOHL
      Y1=Q3-Q1*R3-Q2*T3                                                  KOHL
      Y2=Q4-Q1*R4-Q2*T4                                                  KOHL
      AU1=Q1                                                             KOHL
      AU2=-(RS4*Y1-RS3*Y2)/G24                                           KOHL
      AU3=Q2                                                             KOHL
      AU4=(S4*Y1-S3*Y2)/G24                                              KOHL
      JJ=2                                                               KOHL
      GO TO 406                                                          KOHL
C                  K2=L1=1, L2=H1=0                                      KOHL
405   JJ=3                                                               KOHL
406   IF(ABS(G14).LT.0.5)GO TO 900                                       KOHL
407   Y1=Q3-Q2*S3-Q1*T3                                                  KOHL
      Y2=Q4-Q2*S4-Q1*T4                                                  KOHL
      AW1=(-RS4*Y1+RS3*Y2)/G14                                           KOHL
      AW2=Q2                                                             KOHL
      AW3=Q1                                                             KOHL
      AW4=(R4*Y1-R3*Y2)/G14                                              KOHL
C     LOESUNGEN MIT K2,L2  VARIABEL, H1,L1 KONSTANT                      KOHL
410   CONTINUE                                                           KOHL
      DO 500 LC=1,3                                                      KOHL
      T2=P(LC)                                                           KOHL
      T2E=T2-1                                                           KOHL
      T2G=T2*G24                                                         KOHL
      T2C=T2*AU3                                                         KOHL
      DO 500 KC=KC1,3                                                    KOHL
      S2=P(KC)                                                           KOHL
      S2E=S2-1                                                           KOHL
      S2U=S2E                                                            KOHL
      IF(JJ-2)415,425,420                                                KOHL
C                  H1=1, L1=0                                            KOHL
415   DE1=G34*S2+T2G                                                     KOHL
      IF(ABS(DE1).LT.0.5)GO TO 419                                       KOHL
      YT=(S2U*AU2+T2C)/DE1                                               KOHL
416   ZH=1                                                               KOHL
      ZL=0                                                               KOHL
      A1=AU1                                                             KOHL
      A2=AU2-YT*G34                                                      KOHL
      A3=AU3-YT*G24                                                      KOHL
      A4=AU4-YT*G23                                                      KOHL
      GO TO 430                                                          KOHL
419   IF(ABS(G14).LT.0.5)GO TO 500                                       KOHL
C                  H1=0, L1=1                                            KOHL
420   DE2=S2*G14                                                         KOHL
      YT=(S2E*Q2+T2*Q1)/DE2                                              KOHL
      A1=AW1+YT*G24                                                      KOHL
      A2=AW2-YT*G14                                                      KOHL
      A3=AW3                                                             KOHL
      A4=AW4-YT*G12                                                      KOHL
      ZH=0.                                                              KOHL
      ZL=1.                                                              KOHL
      GO TO 430                                                          KOHL
C                  H1=1, L1=0, G34=0                                     KOHL
425   IF(ABS(T2G).LT.0.5)GO TO 420                                       KOHL
      YT=(S2*AU2+T2E*AU3)/T2G                                            KOHL
      GO TO 416                                                          KOHL
430   CONTINUE                                                           KOHL
C     ALLGEMEINE LOESUNGEN                                               KOHL
      WG1=S2*G34+T2*G24                                                  KOHL
      WG2=-T2*G14                                                        KOHL
      WG3=S2*G14                                                         KOHL
      WG4=S2*G13-T2*G12                                                  KOHL
C                                                                        KOHL
      JS=2                                                               KOHL
      DO 495 LD=1,3                                                      KOHL
      T1=P(LD)                                                           KOHL
      WL=T1*WG3                                                          KOHL
      YC=(T1-ZL)*A3                                                      KOHL
      DO 495 HD=HD1,3                                                    KOHL
      R1=P(HD)                                                           KOHL
      DET=R1*WG1+WL                                                      KOHL
      IF(ABS(DET).LT.0.5)GO TO 490                                       KOHL
      YS=((R1-ZH)*A1+YC)/DET                                             KOHL
      A=A1-YS*WG1                                                        KOHL
      B=A2-YS*WG2                                                        KOHL
      C=A3-YS*WG3                                                        KOHL
      D=A4-YS*WG4                                                        KOHL
      IF(A)490,490,1080                                                  KOHL
490   CONTINUE                                                           KOHL
495   CONTINUE                                                           KOHL
500   CONTINUE                                                           KOHL
900   CONTINUE                                                           KOHL
      IF(RS3-0.1)1000,1000,999                                           KOHL
999   IF(HA.EQ.1)GO TO 1000                                              KOHL
      IF(KA.EQ.1)GO TO 1000                                              KOHL
      RS3=-RS3                                                           KOHL
      GO TO 110                                                          KOHL
1000  CONTINUE                                                           KOHL
1010  CONTINUE                                                           KOHL
1020  CONTINUE                                                           KOHL
1030  CONTINUE                                                           KOHL
1040  CONTINUE                                                           KOHL
1050  CONTINUE                                                           KOHL
      IF(LL-2)1060,1061,1061                                             KOHL
1060  LL=2                                                               KOHL
      KC1=3                                                              KOHL
      HD1=3                                                              KOHL
      HC1=3                                                              KOHL
      M3=H3M+1                                                           KOHL
      M4=H4M+1                                                           KOHL
      N3=K3M+1                                                           KOHL
      N4=K4M+1                                                           KOHL
      HPA=5                                                              KOHL
      GO TO 100                                                          KOHL
1061  CONTINUE                                                           KOHL
      IF(JAZ)1500,1500,1070                                              KOHL
1070  CALL AMT(JAZ,4)                                                    KOHL
      GO TO 1500                                                         KOHL
C     UEBERPRUEFUNG DER GEFUNDENEN ELEMENTARZELLEN MIT VOLUMSBEDINGUNG   KOHL
1080  CONTINUE                                                           KOHL
      IZB=IZB+1                                                          KOHL
      IF(LL-2)1085,1081,1085                                             KOHL
1081  AA=A+B                                                             KOHL
      DD=ABS(A-B)                                                        KOHL
      A=AA+D                                                             KOHL
      B=AA-D                                                             KOHL
      D=DD*2                                                             KOHL
1085  FZ=A*B-0.25*D*D                                                    KOHL
      IF(FZ)1250,1250,1086                                               KOHL
1086  VOL=FZ*C                                                           KOHL
      DO 1090 I=1,JV                                                     KOHL
      IF(VOL-VG(I))1089,1089,1090                                        KOHL
1089  IF(VOL-VK(I))1250,1091,1091                                        KOHL
1090  CONTINUE                                                           KOHL
      GO TO 1250                                                         KOHL
1091  CONTINUE                                                           KOHL
C     UEBERPRUEFUNG DER GEFUNDENEN ELEMENTARZELLEN MIT UEBRIGEN Q-WERTEN KOHL
      IZC=IZC+1                                                          KOHL
      CI=1./C                                                            KOHL
      D=ABS(D)                                                           KOHL
      LU=0                                                               KOHL
      GRK=FZ/A                                                           KOHL
      A2M=A+A                                                            KOHL
      DO 1200 I=5,NQ                                                     KOHL
      QQ=Q(I)                                                            KOHL
      IF(QQ.GT.(258.*A))GO TO 1200                                       KOHL
      EPS=QQ*FEHL                                                        KOHL
      EPS2=EPS+EPS                                                       KOHL
      EPC=EPS2*CI                                                        KOHL
      EPC1=EPS*CI                                                        KOHL
1100  F=QQ+EPS                                                           KOHL
1103  FK=0.                                                              KOHL
1104  CONTINUE                                                           KOHL
      F1=F-B*FK*FK                                                       KOHL
      IF(F1)1120,1105,1105                                               KOHL
1105  F2=D*FK                                                            KOHL
      F3=0.                                                              KOHL
      H=1                                                                KOHL
1107  CONTINUE                                                           KOHL
      F6=F1-A*P(H)-F3                                                    KOHL
      IF(F6)1111,1108,1108                                               KOHL
1108  FA1=F6*CI+2.                                                       KOHL
      IF(FA1.GT.84.99)GO TO 1110                                         KOHL
      FA2=FA1-EPC                                                        KOHL
      I1=FA1                                                             KOHL
      I2=FA2                                                             KOHL
      IF(IG(I1)-IG(I2))1200,1109,1200                                    KOHL
1109  H=H+1                                                              KOHL
      F3=F3+F2                                                           KOHL
      GO TO 1107                                                         KOHL
1110  FA1=FA1-2.                                                         KOHL
      F7=SQRT(FA1)                                                       KOHL
      I7=F7                                                              KOHL
      F8=I7                                                              KOHL
      IF((FA1-F7*F8).LT.EPC1)GO TO 1200                                  KOHL
      IF(F1)1126,1109,1109                                               KOHL
1111  IF(F2)1115,1115,1112                                               KOHL
1112  F3=-F2                                                             KOHL
      H=2                                                                KOHL
      F2=-F2                                                             KOHL
      GO TO 1107                                                         KOHL
1115  FK=FK+1.                                                           KOHL
      GO TO 1104                                                         KOHL
1120  CONTINUE                                                           KOHL
      IF(F-GRK*FK*FK)1150,1150,1121                                      KOHL
1121  F2=D*FK-A                                                          KOHL
      F6=F1                                                              KOHL
1123  F6=F6+F2                                                           KOHL
      IF(F6)1124,1125,1125                                               KOHL
1124  IF(F2)1115,1126,1126                                               KOHL
1125  CONTINUE                                                           KOHL
      FA1=F6*CI+2.                                                       KOHL
      FA2=FA1-EPC                                                        KOHL
      I1=FA1                                                             KOHL
      I2=FA2                                                             KOHL
      IF(IG(I1)-IG(I2))1200,1126,1200                                    KOHL
1126  F2=F2-A2M                                                          KOHL
      GO TO 1123                                                         KOHL
1150  LU=LU+1                                                            KOHL
      IF(LU.GT.LUFM)GO TO 1250                                           KOHL
1200  CONTINUE                                                           KOHL
      JAZ=JAZ+1                                                          KOHL
      AZ(1,JAZ)=A                                                        KOHL
      AZ(2,JAZ)=B                                                        KOHL
      AZ(3,JAZ)=C                                                        KOHL
      AZ(4,JAZ)=D                                                        KOHL
      AZ(5,JAZ)=0.                                                       KOHL
      AZ(6,JAZ)=0.                                                       KOHL
      VVV(JAZ)=VOL                                                       KOHL
      IF(JAZ-500)1250,1202,1202                                          KOHL
1202  CALL AMT(JAZ,4)                                                    KOHL
      IF(TRZ2.GT.TILL)CALL EXIT                                          KOHL
      JAZ=0                                                              KOHL
1250  CONTINUE                                                           KOHL
      IF(JS.EQ.1)GO TO 299                                               KOHL
      GO TO 490                                                          KOHL
1270  CONTINUE                                                           KOHL
      IF(JAZ.GT.0)GO TO 1202                                             KOHL
1500  CONTINUE                                                           KOHL
      IF(WMB.GT.10.)GO TO 1600                                           KOHL
      IF(IUNAB.LE.0)GO TO 1600                                           KOHL
      IF(IRUN.GE.1)GO TO 1600                                            KOHL
      IRUN=IRUN+1                                                        KOHL
      WRITE(6,2002)                                                      KOHL
      GO TO 10                                                           KOHL
1600  CONTINUE                                                           KOHL
      RETURN                                                             KOHL
2000  FORMAT(//42X,27HSEARCH FOR MONOCLINIC CELLS/42X,27(1H*)//)         KOHL
2001  FORMAT(12H0BASELINES  ,8X,3HQ1=,F8.5,5X,3HQ2=,F8.5,5X,3HQ3=,F8.5   KOHL
     1,5X,3HQ4=,F8.5,42X,3HW= ,F4.1/)                                    KOHL
2002  FORMAT(/94H NO SOLUTION WITH M20 GREATER THAN 10 DETECTED. A SECON KOHL
     1D TRIAL WITH NEW BASIC LINES IS STARTED)                           KOHL
      END                                                                KOHL
      SUBROUTINE ORDER(Q,FEHL,MQ)                                        KOHL
      DIMENSION Q(50),F(3)                                               KOHL
      DATA F/2.25,4.,9./                                                 KOHL
      NQ=MQ                                                              KOHL
      CALL SORT1(NQ,Q,50,1)                                              KOHL
      X=1.+FEHL                                                          KOHL
      Y=1.-FEHL                                                          KOHL
      K2=16                                                              KOHL
      DO 20 J=1,6                                                        KOHL
      L=1                                                                KOHL
      QJL=Q(J)*F(1)                                                      KOHL
      K1=J+1                                                             KOHL
      DO 15 K=K1,K2                                                      KOHL
4     IF(QJL-Q(K)*Y)10,5,5                                               KOHL
5     IF(QJL-Q(K)*X)6,6,15                                               KOHL
6     QX=Q(K)                                                            KOHL
      NQ=MQ-1                                                            KOHL
      DO 7I=K,NQ                                                         KOHL
7     Q(I)=Q(I+1)                                                        KOHL
      Q(NQ+1)=QX                                                         KOHL
      IF(L.NE.1)MQ=MQ-1                                                  KOHL
10    IF(L.GE.3)GO TO 16                                                 KOHL
      L=L+1                                                              KOHL
      QJL=Q(J)*F(L)                                                      KOHL
       IF(QJL-Q(K2)*Y)4,4,16                                             KOHL
15    CONTINUE                                                           KOHL
16    CONTINUE                                                           KOHL
20    CONTINUE                                                           KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE ORIN(NNN,Q1,Q2,Q3,V1,V2,NZ,MAO)                         KOHL
      IMPLICIT INTEGER(H)                                                KOHL
      DIMENSION VV1(20),VV2(20),F(10),FI(10),G(10),FAK(10),DAK(10),      KOHL
     1DCK(10),FGK(10)                                                    KOHL
      COMMON/LSG/AZ(6,500),VVV(500)/OR/IM,NQ                             KOHL
      FAK(1)=0.                                                          KOHL
      DATA F/0.,1.,4.,9.,16.,25.,36.,49.,64.,81./                        KOHL
      IF(MAO)6,8,8                                                       KOHL
6     MAO=0                                                              KOHL
      GO TO 100                                                          KOHL
8     CONTINUE                                                           KOHL
      IMM=IM+2                                                           KOHL
      IM1=IM-1                                                           KOHL
      FG=F(IM)-0.01                                                      KOHL
      DO 10 I=1,10                                                       KOHL
10    FGK(I)=FG-F(I)                                                     KOHL
      DO 20 I=2,9                                                        KOHL
      FI(I)=1./F(I)                                                      KOHL
      G(I)=F(I)-1                                                        KOHL
20    FAK(I)=-G(I)*FI(I)                                                 KOHL
      DO 30 I=1,NZ                                                       KOHL
      J=NZ+1-I                                                           KOHL
      VV1(J)=1./(FLOAT(I)*V2)**2                                         KOHL
30    VV2(J)=1./(FLOAT(I)*V1)**2                                         KOHL
C     BERECHNUNG VON A,B,C  FUER L1=L2=0                                 KOHL
      L1=1                                                               KOHL
      L2=1                                                               KOHL
      NU1=3                                                              KOHL
      NU2=NNN                                                            KOHL
      ISU=4                                                              KOHL
      AMI=Q1*0.01                                                        KOHL
      DO 160 H2=1,IMM                                                    KOHL
      DO 160 K1=1,IM                                                     KOHL
      DEZ=F(H2)*F(K1)                                                    KOHL
      DO 150 K2=1,IMM                                                    KOHL
      DO 140 H1=K1,IMM                                                   KOHL
      IF(H1.GT.H2.AND.K1.GT.K2)GO TO 150                                 KOHL
      DE=F(H1)*F(K2)-DEZ                                                 KOHL
      IF(ABS(DE).LT.0.5)GO TO 140                                        KOHL
      DEI=1./DE                                                          KOHL
      A=(F(K2)*Q1-F(K1)*Q2)*DEI                                          KOHL
      IF(A.LT.AMI)GO TO 140                                              KOHL
      B=(F(H1)*Q2-F(H2)*Q1)*DEI                                          KOHL
      IF(B.LT.AMI)GO TO 140                                              KOHL
      FLCH=A*B                                                           KOHL
      DO 130 H3=1,IMM                                                    KOHL
      QA3=Q3-A*F(H3)                                                     KOHL
      IF(QA3.LT.0)GO TO 140                                              KOHL
      DO 120 K3=1,IMM                                                    KOHL
      CZ=QA3-B*F(K3)                                                     KOHL
      IF(CZ.LT.0.)GO TO 130                                              KOHL
      DO 110 L3=2,IM                                                     KOHL
      C=CZ*FI(L3)                                                        KOHL
      GO TO 60                                                           KOHL
107   IF(VOL.LT.VV2(1))GO TO 120                                         KOHL
110   CONTINUE                                                           KOHL
120   CONTINUE                                                           KOHL
130   CONTINUE                                                           KOHL
140   CONTINUE                                                           KOHL
150   CONTINUE                                                           KOHL
160   CONTINUE                                                           KOHL
      GO TO 170                                                          KOHL
60    CONTINUE                                                           KOHL
63    CONTINUE                                                           KOHL
      IF(A.LT.AMI.OR.B.LT.AMI)GO TO 100                                  KOHL
65    CONTINUE                                                           KOHL
      VOL=FLCH*C                                                         KOHL
      DO 100 I=1,NZ                                                      KOHL
      IF(VOL-VV2(I))105,85,85                                            KOHL
85    IF(VOL-VV1(I))90,90,100                                            KOHL
90    CALL QZO(A,B,C,6,3,6,-1,INX)                                       KOHL
      IF(INX.LE.0)GO TO 100                                              KOHL
      CALL QZO(A,B,C,NNN,3,NNN,-1,INX)                                   KOHL
      IF(INX)100,100,95                                                  KOHL
95    MAO=MAO+1                                                          KOHL
      VVV(MAO)=VOL                                                       KOHL
      AZ(1,MAO)=A                                                        KOHL
      AZ(2,MAO)=B                                                        KOHL
      AZ(3,MAO)=C                                                        KOHL
      IF(MAO.EQ.500)RETURN                                               KOHL
100   CONTINUE                                                           KOHL
105   GO TO (235,280,350,107),ISU                                        KOHL
 170  CONTINUE                                                           KOHL
C     ALLGEMEINE  MATRIXINVERSION                                        KOHL
      DO 400 L3=1,IM1                                                    KOHL
      FL32=F(L3)*Q2                                                      KOHL
      DO 400 K3=L3,IM                                                    KOHL
      FK32=F(K3)*Q2                                                      KOHL
      KS=K3                                                              KOHL
      IF(KS.LE.1)KS=2                                                    KOHL
      DO 400 H3=KS,IMM                                                   KOHL
      FH32=F(H3)*Q2                                                      KOHL
      DO 400 L2=1,IM                                                     KOHL
      FL23=F(L2)*Q3                                                      KOHL
      FL=-FL32+FL23                                                      KOHL
      K2S=1                                                              KOHL
      IF(L3.EQ.K3)K2S=L2                                                 KOHL
      DO 400 K2=K2S,IM                                                   KOHL
      HT=IM                                                              KOHL
      HS=1                                                               KOHL
      IF(L2.GE.L3.AND.K2.GE.K3)HT=H3-1                                   KOHL
      IF(HS.GT.HT)GO TO 400                                              KOHL
      FK23= F(K2)*Q3                                                     KOHL
      FK=FK23-FK32                                                       KOHL
      E11=F(K2)*F(L3)-F(K3)*F(L2)                                        KOHL
      DO 390 H2=HS,HT                                                    KOHL
      E21=-F(H2)*F(L3)+F(H3)*F(L2)                                       KOHL
      E31=F(H2)*F(K3)-F(H3)*F(K2)                                        KOHL
      FH23=F(H2)*Q3                                                      KOHL
      FH=FH23-FH32                                                       KOHL
      IF(ABS(E11)-0.5)200,202,202                                        KOHL
200   IE1=0                                                              KOHL
      IF(ABS(E21).LT.0.5.AND.ABS(E31).LT.0.5)GO TO 390                   KOHL
      GO TO 203                                                          KOHL
202   IE1=1                                                              KOHL
      EH2=E21/E11                                                        KOHL
      EH3=E31/E11                                                        KOHL
      AS1=Q1                                                             KOHL
      BS1=EH2*Q1-FL/E11                                                  KOHL
      CS1=EH3*Q1+FK/E11                                                  KOHL
203   CONTINUE                                                           KOHL
      IF(ABS(E21)-0.5)205,205,207                                        KOHL
205   IE2=0                                                              KOHL
      GO TO 208                                                          KOHL
207   EK1=E11/E21                                                        KOHL
      EK3=E31/E21                                                        KOHL
      AS2=EK1*Q1+FL/E21                                                  KOHL
      BS2=Q1                                                             KOHL
      CS2=EK3*Q1-FH/E21                                                  KOHL
      IE2=1                                                              KOHL
208   CONTINUE                                                           KOHL
      IF(ABS(E31)-0.5)210,210,212                                        KOHL
210   IE3=0                                                              KOHL
      GO TO 213                                                          KOHL
212   EL1=E11/E31                                                        KOHL
      EL2=E21/E31                                                        KOHL
      AS3=EL1*Q1-FK/E31                                                  KOHL
      BS3=EL2*Q1+FH/E31                                                  KOHL
      CS3=Q1                                                             KOHL
      IE3=1                                                              KOHL
213   CONTINUE                                                           KOHL
C     L1=0  ODER  H2**2*K3**2=H3**2*K2**2                                KOHL
C         H2**2*L3**2=H3**2*L2**2                                        KOHL
      IF(L2.EQ.1.AND.IE3.NE.0)GO TO 320                                  KOHL
220   IF(IE2)222,222,260                                                 KOHL
222   CONTINUE                                                           KOHL
      IF(IE1.EQ.0)GO TO 320                                              KOHL
      AL=AS1                                                             KOHL
      B=BS1                                                              KOHL
      CL=CS1                                                             KOHL
      ISU=1                                                              KOHL
      R1K=B*EH3                                                          KOHL
      DO 225 J=2,IM                                                      KOHL
      DAK(J)=-F(J)*B                                                     KOHL
225   DCK(J)=-F(J)*R1K                                                   KOHL
      L1S=1                                                              KOHL
      IF(L2.EQ.1)L1S=2                                                   KOHL
      DO 250 L1=L1S,IM                                                   KOHL
      AK=AL                                                              KOHL
      CK=CL                                                              KOHL
      K1M=1                                                              KOHL
      IF(K2.EQ.1)GO TO 238                                               KOHL
      K1=K1M                                                             KOHL
230   A=AK                                                               KOHL
      C=CK                                                               KOHL
      H1M=IM                                                             KOHL
      IF(L1.GE.L2.AND.K1.GE.K2)H1M=H2-1                                  KOHL
      IF(H1M.LT.2)GO TO 240                                              KOHL
      H1=2                                                               KOHL
232   FLCH=A*B                                                           KOHL
      GO TO 60                                                           KOHL
235   IF(H1.GE.H1M)GO TO 238                                             KOHL
      H1=H1+1                                                            KOHL
      WK=AK*FAK(H1)                                                      KOHL
      A=AK+WK                                                            KOHL
      C=CK+WK*EH3                                                        KOHL
      GO TO 232                                                          KOHL
238   CONTINUE                                                           KOHL
      IF(K1.GE.IM)GO TO 240                                              KOHL
      K1=K1+1                                                            KOHL
      AK=AL+DAK(K1)                                                      KOHL
      CK=CL+DCK(K1)                                                      KOHL
      GO TO 230                                                          KOHL
240   CONTINUE                                                           KOHL
      IF(IE3.NE.0)GO TO 320                                              KOHL
      AL=AS1-F(L1+1)*CS1                                                 KOHL
250   CONTINUE                                                           KOHL
      GO TO 400                                                          KOHL
C     (H2**2*L3**2).NE.(H3**2*L2**2)                                     KOHL
260   CONTINUE                                                           KOHL
      DO 262 I=2,IM                                                      KOHL
      DAK(I)=FAK(I)*EK1                                                  KOHL
262   DCK(I)=FAK(I)*EK3                                                  KOHL
      AL=AS2                                                             KOHL
      BL=BS2                                                             KOHL
      CL=CS2                                                             KOHL
      ISU=2                                                              KOHL
      L1S=1                                                              KOHL
      IF(L2.EQ.1)L1S=2                                                   KOHL
      DO 300 L1=L1S,IM                                                   KOHL
      AK=AL                                                              KOHL
      BK=BL                                                              KOHL
      CK=CL                                                              KOHL
      K1=2                                                               KOHL
270   CONTINUE                                                           KOHL
      A=AK                                                               KOHL
      B=BK                                                               KOHL
      C=CK                                                               KOHL
      H1=1                                                               KOHL
      IF(H2.EQ.1)GO TO 280                                               KOHL
      H1MA=IM                                                            KOHL
      IF(L1-L2)275,272,272                                               KOHL
272   IF(K1-K2)275,273,273                                               KOHL
273   H1MA=H2-1                                                          KOHL
      IF(H1MA.LT.H1)GO TO 290                                            KOHL
275   FLCH=A*B                                                           KOHL
      GO TO 60                                                           KOHL
280   IF(H1.GE.H1MA)GO TO 282                                            KOHL
      H1=H1+1                                                            KOHL
      F1H=F(K1)*FI(H1)+EK1                                               KOHL
      IF(ABS(F1H).LT.0.00001)GO TO 280                                   KOHL
      WK=-AK/F1H                                                         KOHL
      A=AK+WK*EK1                                                        KOHL
      B=BK+WK                                                            KOHL
      C=CK+WK*EK3                                                        KOHL
      GO TO 275                                                          KOHL
282   CONTINUE                                                           KOHL
      IF(K1.GE.IM)GO TO 290                                              KOHL
      K1=K1+1                                                            KOHL
      AK=AL+BL*DAK(K1)                                                   KOHL
      BK=BL+BL*FAK(K1)                                                   KOHL
      CK=CL+BL*DCK(K1)                                                   KOHL
      GO TO 270                                                          KOHL
290   IF(IE3.NE.0)GO TO 320                                              KOHL
      D2C=-F(L1+1)*CS2                                                   KOHL
      AL=AS2+D2C*EK1                                                     KOHL
      BL=BS2+D2C                                                         KOHL
300   CONTINUE                                                           KOHL
      GO TO 390                                                          KOHL
C           L1.NE.0.AND.H2**2*K3**2.NE.H3**2*K2**2                       KOHL
320   CONTINUE                                                           KOHL
      H1S=1                                                              KOHL
      IF(H2.EQ.1)H1S=2                                                   KOHL
      ISU=3                                                              KOHL
      DO  380 L1=2,IM                                                    KOHL
      WL=FAK(L1)*CS3                                                     KOHL
      AL=AS3+WL*EL1                                                      KOHL
      CL=CS3+WL                                                          KOHL
      BL=BS3+WL*EL2                                                      KOHL
      AK=AL                                                              KOHL
      BK=BL                                                              KOHL
      CK=CL                                                              KOHL
      K1=1                                                               KOHL
      DEL=E31*F(L1)                                                      KOHL
      DELK=DEL                                                           KOHL
      NSI=1                                                              KOHL
340   CONTINUE                                                           KOHL
      H1=H1S                                                             KOHL
      A=AK                                                               KOHL
      B=BK                                                               KOHL
      C=CK                                                               KOHL
      H1MA=IM                                                            KOHL
      IF(L1-L2)344,342,342                                               KOHL
342   IF(K1-K2)344,343,343                                               KOHL
343   H1MA=H2-1                                                          KOHL
      IF(H1MA.LT.H1)GO TO 370                                            KOHL
344   IF(H1S-2)345,354,354                                               KOHL
345   FLCH=A*B                                                           KOHL
      GO TO 60                                                           KOHL
350   CONTINUE                                                           KOHL
      IF(H1.GE.H1MA)GO TO 360                                            KOHL
      H1=H1+1                                                            KOHL
354   IF(NSI)358,358,355                                                 KOHL
355   DELTA=DELK+F(H1)*E11                                               KOHL
      IF(ABS(DELTA).LT.0.5)GO TO 350                                     KOHL
      WH=-F(H1)/DELTA*AK                                                 KOHL
      A=AK+WH*E11                                                        KOHL
      B=BK+WH*E21                                                        KOHL
      C=CK+WH*E31                                                        KOHL
      GO TO 345                                                          KOHL
358   CONTINUE                                                           KOHL
      WH=FAK(H1)*AK                                                      KOHL
      A=AK+WH                                                            KOHL
      B=BK+WH*EH2                                                        KOHL
      C=CK+WH*EH3                                                        KOHL
      GO TO 345                                                          KOHL
360   CONTINUE                                                           KOHL
      IF(K1.GE.IM)GO TO 370                                              KOHL
      K1=K1+1                                                            KOHL
      DELK=DEL+E21*F(K1)                                                 KOHL
      IF(ABS(DELK)-0.5)366,366,364                                       KOHL
364   NSI=1                                                              KOHL
      WK=-F(K1)*BL/DELK                                                  KOHL
      AK=AL+WK*E11                                                       KOHL
      BK=BL+WK*E21                                                       KOHL
      CK=CL+WK*E31                                                       KOHL
      GO TO 340                                                          KOHL
366   IF(IE1.EQ.0)GO TO 360                                              KOHL
      NSI=-1                                                             KOHL
      WK=-(AL+F(K1)*BL)                                                  KOHL
      AK=AL+WK                                                           KOHL
      BK=BL+WK*EH2                                                       KOHL
      CK=CL+WK*EH3                                                       KOHL
      GO TO 340                                                          KOHL
370   CONTINUE                                                           KOHL
380   CONTINUE                                                           KOHL
390   CONTINUE                                                           KOHL
400   CONTINUE                                                           KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE ORTHOR(V1Z,VD1Z,NZMAX,ITA)                              KOHL
      DIMENSION MC(10),AMC(10)                                           KOHL
      COMMON FEL(50),Q(50),MMM,LUFM,FEHLP,ITER/LSG/AZ(6,500),VVV(500)    KOHL
     1/OR/IM,NNN                                                         KOHL
      DO 2 I=1,NNN                                                       KOHL
2     VVV(I)=1./VVV(I)                                                   KOHL
      WRITE(6,513)                                                       KOHL
      CALL SORT1(NNN,VVV,500,1)                                          KOHL
      I4=2                                                               KOHL
      I3=11                                                              KOHL
      IF(NNN.LT.11)GO TO 8                                               KOHL
      A=VVV(1)*0.5                                                       KOHL
3     X=(1.+0.5*FEHLP)/A                                                 KOHL
      Y=(1.-0.5*FEHLP)/A                                                 KOHL
      DO 6 I=I4,10                                                       KOHL
      I1=VVV(I)*X                                                        KOHL
      I2=VVV(I)*Y                                                        KOHL
      IF(I1-I2)4,6,4                                                     KOHL
4     S=VVV(I)                                                           KOHL
      VVV(I)=VVV(I3)                                                     KOHL
      VVV(I3)=S                                                          KOHL
      IF(I3.GE.NNN)GO TO 8                                               KOHL
      I3=I3+1                                                            KOHL
6     CONTINUE                                                           KOHL
      CALL SORT1(10,VVV,500,1)                                           KOHL
      IF(I4.EQ.3)GO TO 8                                                 KOHL
      A=VVV(2)*0.5                                                       KOHL
      I4=3                                                               KOHL
      GO TO 3                                                            KOHL
8     CONTINUE                                                           KOHL
      DO 9 I=1,NNN                                                       KOHL
9     Q(I)=VVV(I)*VVV(I)                                                 KOHL
      DO 10 I=1,NNN                                                      KOHL
10    FEL(I)=Q(I)*FEHLP                                                  KOHL
      A=Q(1)                                                             KOHL
      B=Q(2)                                                             KOHL
      CALL UNOR(3,8,MC,MCH)                                              KOHL
      DO 12 I=1,MCH                                                      KOHL
      J=MC(I)                                                            KOHL
12    AMC(I)=Q(J)                                                        KOHL
      Q(1)=0.1E-10                                                       KOHL
      Q(2)=0.2E-10                                                       KOHL
      CALL SORT1(NNN,Q,50,1)                                             KOHL
      Q(1)=A                                                             KOHL
      Q(2)=B                                                             KOHL
      DO 13 I=1,NNN                                                      KOHL
13    FEL(I)=Q(I)*FEHLP                                                  KOHL
      AS=SQRT(A)                                                         KOHL
      BS=SQRT(B)                                                         KOHL
      NRE=NNN                                                            KOHL
      IF(NRE.GT.20)NRE=20                                                KOHL
      DRE=SQRT(Q(NRE))                                                   KOHL
      RNE=NRE                                                            KOHL
      VMA=8.*RNE/(0.524*DRE*Q(NRE))                                      KOHL
      MAO=0                                                              KOHL
      DO 30 JJ=1,MCH                                                     KOHL
      MAO1=MAO+1                                                         KOHL
C                                                                        KOHL
      C=AMC(JJ)                                                          KOHL
      WRITE(6,508)A,B,C                                                  KOHL
      IF(V1Z.GT.0)GO TO 15                                               KOHL
      V1=VMA*0.75                                                        KOHL
      V2=1./SQRT(A*B*C)                                                  KOHL
      WRITE(6,506)V1,V2                                                  KOHL
      NZ=1                                                               KOHL
      GO TO 28                                                           KOHL
15    VR=VD1Z+1.5*FEHLP*V1Z                                              KOHL
      V1=V1Z+VR                                                          KOHL
      V2=V1Z-VR                                                          KOHL
      NZ=VMA/V2                                                          KOHL
      IF(NZ.GT.NZMAX)NZ=NZMAX                                            KOHL
28    CONTINUE                                                           KOHL
      CALL ORIN(NNN,A,B,C,V1,V2,NZ,MAO)                                  KOHL
      IF(MAO1.GT.MAO)GO TO 30                                            KOHL
      DO 29 L=MAO1,MAO                                                   KOHL
      AZ(4,L)=0.                                                         KOHL
      AZ(5,L)=0.                                                         KOHL
      AZ(6,L)=0.                                                         KOHL
      A1=1./SQRT(AZ(1,L))                                                KOHL
      A2=1./SQRT(AZ(2,L))                                                KOHL
      A3=1./SQRT(AZ(3,L))                                                KOHL
      VOLUM=1./SQRT(VVV(L))                                              KOHL
      IF(ITA.EQ.1)WRITE(6,512)A1,A2,A3,VOLUM                             KOHL
29    CONTINUE                                                           KOHL
      IF(MAO.LT.500)GO TO 30                                             KOHL
      CALL AMT(MAO,3)                                                    KOHL
      MAO=-1                                                             KOHL
      MAO1=1                                                             KOHL
      GO TO 28                                                           KOHL
30    CONTINUE                                                           KOHL
      IF(MAO.LE.0)RETURN                                                 KOHL
      CALL AMT(MAO,3)                                                    KOHL
509   FORMAT(1X,20A4)                                                    KOHL
506   FORMAT(1X,3HV1=,F10.4,10X,3HV2=,F10.4)                             KOHL
508   FORMAT(1H ,9HBASELINES,5X,3HQ1=,F8.5,5X,3HQ2=,F8.5,5X,3HQ3=,F8.5)  KOHL
512   FORMAT(1X,3E15.6,10X,E15.6)                                        KOHL
513   FORMAT(//42X,29HSEARCH FOR ORTHORHOMBIC CELLS/42X,29(1H*)////)     KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE QERZ(A1,A2,A3,A4,A5,A6,Q,IQZM,MONO,QI,NQ,P,IRM,ISP,INS  KOHL
     1,IW,Q20,IV)                                                        KOHL
      COMMON FEL(50),QAN(50),NNN,LUFM,FEHLP,ITER                         KOHL
     1/VQ/PF(50),LH(50),LK(50),LL(50),PF2(50)                            KOHL
     1,LH2(50),LK2(50),LL2(50),PFA(50)/VS/QP(400),IH(400),IK(400)        KOHL
     2,IL(400)                                                           KOHL
      DIMENSION QI(50),P(50)                                             KOHL
      INTEGER HD,HE,HD0                                                  KOHL
      VLM=A4*A5*A6-A1*A5**2-A2*A6**2                                     KOHL
      IW=0                                                               KOHL
      IV=0                                                               KOHL
      WI=4.*A1*A2-A4**2                                                  KOHL
      IF(WI)99,99,100                                                    KOHL
99    IRM=0                                                              KOHL
      GO TO 500                                                          KOHL
100   CONTINUE                                                           KOHL
      AB4=4.*A1*A2                                                       KOHL
      MONO=6                                                             KOHL
       IDMO=1                                                            KOHL
      WIM=8.5E-06                                                        KOHL
      TA4=A4**2/AB4-WIM                                                  KOHL
      BC4=4.*A2*A3                                                       KOHL
      TA5=A5**2/BC4-WIM                                                  KOHL
      IF(TA4)406,440,440                                                 KOHL
406   IF(TA5)410,420,420                                                 KOHL
410   IF(A6**2/(4.*A1*A3)-WIM)411,411,415                                KOHL
411   A4=0.                                                              KOHL
      IDMO=-3                                                            KOHL
      MONO=3                                                             KOHL
      A4=0.                                                              KOHL
      A5=0.                                                              KOHL
      A6=0.                                                              KOHL
      VLM=0.                                                             KOHL
      GO TO 460                                                          KOHL
415   AW=A1                                                              KOHL
      A1=A3                                                              KOHL
      A3=A2                                                              KOHL
      A2=AW                                                              KOHL
      A4=A6                                                              KOHL
      GO TO 450                                                          KOHL
420   TA6=A6**2/(4.*A3*A1)-WIM                                           KOHL
      IF(TA6)425,460,460                                                 KOHL
425   AW=A1                                                              KOHL
      A1=A2                                                              KOHL
      A2=A3                                                              KOHL
      A3=AW                                                              KOHL
      A4=A5                                                              KOHL
      GO TO 450                                                          KOHL
440   TA6=A6**2/(4.*A3*A1)-WIM                                           KOHL
      IF(TA6.GE.0..OR.TA5.GE.0.)GO TO 460                                KOHL
450   IDMO=-1                                                            KOHL
      MONO=4                                                             KOHL
      VLM=0.                                                             KOHL
      A5=0.                                                              KOHL
      A6=0.                                                              KOHL
      AB4=4.*A1*A2                                                       KOHL
      IF((A4**2/AB4-WIM).GT.0.)GO TO 460                                 KOHL
      A4=0.                                                              KOHL
      IDMO=-3                                                            KOHL
      MONO=3                                                             KOHL
460   CONTINUE                                                           KOHL
      DO 110 I=1,NQ                                                      KOHL
      PF(I)=10000.                                                       KOHL
      PF2(I)=PFA(I)                                                      KOHL
110   CONTINUE                                                           KOHL
      JK=1                                                               KOHL
      TH=-2.*A1                                                          KOHL
      TK=-2.*A2                                                          KOHL
      THK=-A4                                                            KOHL
      THKS=THK                                                           KOHL
      ZMAX=Q/(A3+VLM/WI)                                                 KOHL
      LMAX=SQRT(ZMAX)                                                    KOHL
      J=0                                                                KOHL
      ID=-1                                                              KOHL
      L=-1                                                               KOHL
115   L=L+1                                                              KOHL
      IN=INS                                                             KOHL
      VVL=L                                                              KOHL
      D0=Q-A3*VVL**2                                                     KOHL
      IF(D0)120,140,140                                                  KOHL
120   VDL=VVL/WI                                                         KOHL
      SHD0=(A4*A5-2.*A2*A6)*VDL                                          KOHL
      SKD0=(A4*A6-2.*A1*A5)*VDL                                          KOHL
      HD0=ABS(SHD0)+0.5                                                  KOHL
      KD0=ABS(SKD0)+0.5                                                  KOHL
      IF(SKD0.LT.0.)KD0=-KD0                                             KOHL
      IF(SHD0.LT.0.)HD0=-HD0                                             KOHL
      RHD=HD0                                                            KOHL
      RKD=KD0                                                            KOHL
      D0=D0-(A1*RHD+A4*RKD+A6*VVL)*RHD-(A2*RKD+A5*VVL)*RKD               KOHL
      IF(D0)401,130,130                                                  KOHL
130   TD0H=-(2.*RHD+1.)*A1-A4*RKD-A6*VVL                                 KOHL
      TD0K=-(2.*RKD+1.)*A2-A4*RHD-A5*VVL                                 KOHL
      GO TO 150                                                          KOHL
140   TD0H=-A1-A6*VVL                                                    KOHL
      TD0K=-A2-A5*VVL                                                    KOHL
      HD0=0                                                              KOHL
      KD0=0                                                              KOHL
150   CONTINUE                                                           KOHL
      TDH=TD0H                                                           KOHL
      TDK=TD0K                                                           KOHL
      D=D0                                                               KOHL
      E=D0                                                               KOHL
      HD=HD0                                                             KOHL
      HE=HD                                                              KOHL
      KE=KD0                                                             KOHL
      KD=KD0                                                             KOHL
      TEH=TDH                                                            KOHL
      IF(L.GT.0.AND.IDMO.GT.0)GO TO 185                                  KOHL
154   IF(E)170,160,160                                                   KOHL
160   J=J+1                                                              KOHL
      IF(ISP)162,162,161                                                 KOHL
161   KU=1                                                               KOHL
      GO TO 300                                                          KOHL
162   IF(J-IQZM)163,163,165                                              KOHL
163   QP(J)=Q-E                                                          KOHL
      IH(J)=HE                                                           KOHL
      IK(J)=KE                                                           KOHL
      IL(J)=L                                                            KOHL
165   TEH=TEH-TH                                                         KOHL
      E=E-TEH                                                            KOHL
      HE=HE-1                                                            KOHL
      GO TO 154                                                          KOHL
170   D=D+TDK                                                            KOHL
      KD=KD+JK                                                           KOHL
      TDK=TDK+TK                                                         KOHL
      TDH=TDH+THK                                                        KOHL
      IF(D)190,180,180                                                   KOHL
180   E=D                                                                KOHL
      TEH=TDH                                                            KOHL
      KE=KD                                                              KOHL
      HE=HD                                                              KOHL
185   J=J+1                                                              KOHL
      IF(ISP)183,183,182                                                 KOHL
182   KU=2                                                               KOHL
      GO TO 300                                                          KOHL
183   IF(J-IQZM)184,184,186                                              KOHL
184   QP(J)=Q-E                                                          KOHL
      IH(J)=HE                                                           KOHL
      IK(J)=KE                                                           KOHL
      IL(J)=L                                                            KOHL
186   E=E+TEH                                                            KOHL
      TEH=TEH+TH                                                         KOHL
      HE=HE+1                                                            KOHL
187   IF(E)188,185,185                                                   KOHL
188   IF(IDMO.EQ.-3)GO TO 170                                            KOHL
      TEH=TDH-TH                                                         KOHL
      E=D-TEH                                                            KOHL
      HE=HD-1                                                            KOHL
      GO TO 154                                                          KOHL
190   E=D+TDH                                                            KOHL
      KE=KD                                                              KOHL
      HE=HD+1                                                            KOHL
      TEH=TDH+TH                                                         KOHL
      IF(E-D)210,210,200                                                 KOHL
200   IF(E)204,185,185                                                   KOHL
204   IF(TEH)210,206,206                                                 KOHL
206   E=E+TEH                                                            KOHL
      TEH=TEH+TH                                                         KOHL
      HE=HE+1                                                            KOHL
      GO TO 200                                                          KOHL
210   TEH=TDH-TH                                                         KOHL
      E=D-TEH                                                            KOHL
      HE=HD-1                                                            KOHL
      IF(E-D)230,230,220                                                 KOHL
220   IF(E)224,160,160                                                   KOHL
224   IF(TEH)228,230,230                                                 KOHL
228   TEH=TEH-TH                                                         KOHL
      E=E-TEH                                                            KOHL
      HE=HE-1                                                            KOHL
      GO TO 220                                                          KOHL
230   CONTINUE                                                           KOHL
      IF(ID)240,250,250                                                  KOHL
240   ID=IDMO                                                            KOHL
      JK=1                                                               KOHL
      THK=THKS                                                           KOHL
      GO TO 400                                                          KOHL
250   ID=-1                                                              KOHL
      JK=-1                                                              KOHL
      TDH=TD0H                                                           KOHL
      TDK=-TD0K+TK                                                       KOHL
      THK=-THK                                                           KOHL
      D=D0                                                               KOHL
      E=D0                                                               KOHL
      HD=HD0                                                             KOHL
      HE=HD                                                              KOHL
      KE=KD0                                                             KOHL
      KD=KD0                                                             KOHL
      TEH=TDH                                                            KOHL
      GO TO 170                                                          KOHL
300   QSP=Q-E                                                            KOHL
      FF=QI(IN)-QSP                                                      KOHL
      IF(FF)310,310,330                                                  KOHL
310   KEN=-1                                                             KOHL
314   IF(ABS(FF)-FEL(IN))350,350,315                                     KOHL
315   IF(FF)316,316,380                                                  KOHL
316   IF(IN-NQ)317,380,380                                               KOHL
317   IN=IN+1                                                            KOHL
      FF=QI(IN)-QSP                                                      KOHL
      GO TO 314                                                          KOHL
330   KEN=1                                                              KOHL
332   IF(ABS(FF)-FEL(IN))350,350,333                                     KOHL
333   IF(FF)380,335,335                                                  KOHL
335   IF(IN-INS)380,380,336                                              KOHL
336   IN=IN-1                                                            KOHL
      FF=QI(IN)-QSP                                                      KOHL
      GO TO 332                                                          KOHL
350   IF(ISP)390,390,355                                                 KOHL
355   EA=ABS(FF)                                                         KOHL
      IF(EA-PF(IN))356,365,365                                           KOHL
356   LH2(IN)=LH(IN)                                                     KOHL
      LK2(IN)=LK(IN)                                                     KOHL
      LL2(IN)=LL(IN)                                                     KOHL
      LH(IN)=HE                                                          KOHL
      LK(IN)=KE                                                          KOHL
      LL(IN)=L                                                           KOHL
      IF(ABS(PF2(IN))-9900.)360,360,361                                  KOHL
360   PF2(IN)=-PF(IN)                                                    KOHL
      GO TO 364                                                          KOHL
361   IF(PF2(IN)+99000.)364,363,363                                      KOHL
363   PF2(IN)=PF(IN)                                                     KOHL
364   PF(IN)=EA                                                          KOHL
      GO TO 370                                                          KOHL
365   IF(ABS(PF2(IN))-9900.)366,366,367                                  KOHL
366   PF2(IN)=-EA                                                        KOHL
      GO TO 370                                                          KOHL
367   IF(PF2(IN)+99000.)370,368,368                                      KOHL
368   PF2(IN)=EA                                                         KOHL
      LH2(IN)=HE                                                         KOHL
      LK2(IN)=KE                                                         KOHL
      LL2(IN)=L                                                          KOHL
370   CONTINUE                                                           KOHL
      IF(KEN)316,316,335                                                 KOHL
380   IF(ISP-1)382,390,382                                               KOHL
382   IF(QSP.LT.Q20)IV=IV+1                                              KOHL
      IF(J-IQZM)384,384,390                                              KOHL
384   IW=IW+1                                                            KOHL
      QP(IW)=QSP                                                         KOHL
      IH(IW)=HE                                                          KOHL
      IK(IW)=KE                                                          KOHL
      IL(IW)=L                                                           KOHL
390   GO TO (165,186),KU                                                 KOHL
400   IF(L.LT.LMAX)GO TO 115                                             KOHL
401   CONTINUE                                                           KOHL
      IRM=0                                                              KOHL
      DO 478 IX=INS,NQ                                                   KOHL
      IF(PF(IX)-9000.)475,475,478                                        KOHL
475   IRM=IRM+1                                                          KOHL
      P(IRM)=QI(IX)                                                      KOHL
      PF(IRM)=PF(IX)                                                     KOHL
      PF2(IRM)=PF2(IX)                                                   KOHL
      IF(PF2(IRM).GT.9000.)PF2(IRM)=-PF2(IRM)                            KOHL
      LH(IRM)=LH(IX)                                                     KOHL
      LK(IRM)=LK(IX)                                                     KOHL
      LL(IRM)=LL(IX)                                                     KOHL
      LH2(IRM)=LH2(IX)                                                   KOHL
      LK2(IRM)=LK2(IX)                                                   KOHL
      LL2(IRM)=LL2(IX)                                                   KOHL
478   CONTINUE                                                           KOHL
500   CONTINUE                                                           KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE QZO(A,B,C,NNN,NU1,NU2,IST,INX)                          KOHL
      INTEGER H                                                          KOHL
      DIMENSION HH(10),QQ(50),IQS(9),FEL(50)                             KOHL
      COMMON FFEL(50),Q(50),MMM,LUFM,FEHLP,ITER/VS/QP(400),IH(400)       KOHL
     1,IK(400),IL(400)/QZ/IQ(9),IQN(9)                                   KOHL
      DATA HH/0.,1.,4.,9.,16.,25.,36.,49.,64.,81./                       KOHL
      PMX=0.                                                             KOHL
      PA=0.                                                              KOHL
      INY=0                                                              KOHL
      QMI=Q(NU1)                                                         KOHL
      QMA=Q(NU2)                                                         KOHL
      NUG=NU2                                                            KOHL
      NUK=NU1                                                            KOHL
      IF(PMX.GT.QMA)QMA=PMX                                              KOHL
      IF(PA.GT.QMA)QMA=PA                                                KOHL
      NA=0                                                               KOHL
      NMX=-1                                                             KOHL
      ID=IABS(IST)+1                                                     KOHL
      DO 10 I=1,NNN                                                      KOHL
      FEL(I)=FFEL(I)                                                     KOHL
10    QQ(I)=Q(I)                                                         KOHL
      IN=NU1                                                             KOHL
      QG=QMA*(1.+FEHLP)                                                  KOHL
      LGR=10                                                             KOHL
      IF(IST.EQ.0)LGR=1                                                  KOHL
      DO 120 L=1,LGR                                                     KOHL
      PL=C*HH(L)                                                         KOHL
      IF(PL.GT.QG)GO TO 122                                              KOHL
      DO 110 K=1,10                                                      KOHL
      PK=PL+B*HH(K)                                                      KOHL
      IF(PK.GT.QG)GO TO 112                                              KOHL
      DO 100 H=1,10                                                      KOHL
      P=PK+A*HH(H)                                                       KOHL
      IF(P.GT.QG)GO TO 102                                               KOHL
      IF(ID-1)35,35,30                                                   KOHL
30    IF(P.LE.PMX)NMX=NMX+1                                              KOHL
      IF(IST.LE.0)GO TO 35                                               KOHL
      IF(P.GT.PA)GO TO 35                                                KOHL
      NA=NA+1                                                            KOHL
      QP(NA)=P                                                           KOHL
      IH(NA)=H                                                           KOHL
      IK(NA)=K                                                           KOHL
      IL(NA)=L                                                           KOHL
35    CONTINUE                                                           KOHL
      FF=QQ(IN)-P                                                        KOHL
      IF(FF)40,40,50                                                     KOHL
40    KEN=-1                                                             KOHL
42    CONTINUE                                                           KOHL
      IF(ABS(FF)-FEL(IN))60,60,43                                        KOHL
43    IF(FF)45,45,99                                                     KOHL
45    IF(IN-NUG)46,99,99                                                 KOHL
46    IN=IN+1                                                            KOHL
      FF=QQ(IN)-P                                                        KOHL
      GO TO 42                                                           KOHL
50    KEN=1                                                              KOHL
52    CONTINUE                                                           KOHL
      IF(ABS(FF)-FEL(IN))60,60,53                                        KOHL
53    IF(FF)99,55,55                                                     KOHL
55    IF(IN-NUK)99,99,56                                                 KOHL
56    IN=IN-1                                                            KOHL
      FF=QQ(IN)-P                                                        KOHL
      GO TO 52                                                           KOHL
60    GO TO (75,61),ID                                                   KOHL
61    CONTINUE                                                           KOHL
      IF(NUG-NUK-LUFM)73,73,62                                           KOHL
62    IF(KEN)63,63,68                                                    KOHL
63    IF(IN-NUK)66,66,64                                                 KOHL
64    IM=IN-NUK                                                          KOHL
      DO 65 J=1,IM                                                       KOHL
      I=IN-J                                                             KOHL
      FEL(I+1)=FEL(I)                                                    KOHL
65    QQ(I+1)=QQ(I)                                                      KOHL
66    NUK=NUK+1                                                          KOHL
      GO TO 43                                                           KOHL
68    IF(IN-NUG)69,72,72                                                 KOHL
69    IM=NUG-1                                                           KOHL
      DO 70 I=IN,IM                                                      KOHL
      FEL(I)=FEL(I+1)                                                    KOHL
70    QQ(I)=QQ(I+1)                                                      KOHL
72    NUG=NUG-1                                                          KOHL
      GO TO 53                                                           KOHL
73    INX=1                                                              KOHL
      GO TO 200                                                          KOHL
75    CONTINUE                                                           KOHL
      DO 76 I=1,INY                                                      KOHL
      IF(IN.EQ.IQS(I))GO TO 78                                           KOHL
76    CONTINUE                                                           KOHL
      IQN(IN)=IQN(IN)+1                                                  KOHL
      INY=INY+1                                                          KOHL
      IQS(INY)=IN                                                        KOHL
78    IF(KEN)43,43,53                                                    KOHL
99    CONTINUE                                                           KOHL
100   CONTINUE                                                           KOHL
102   CONTINUE                                                           KOHL
110   CONTINUE                                                           KOHL
112   CONTINUE                                                           KOHL
120   CONTINUE                                                           KOHL
122   CONTINUE                                                           KOHL
      IF(IST)140,150,140                                                 KOHL
140   INX=-1                                                             KOHL
      GO TO 200                                                          KOHL
150   IF(INY.LE.INX)GO TO 200                                            KOHL
      DO 152 I=1,INY                                                     KOHL
152   IQ(I)=IQS(I)                                                       KOHL
      INX=INY                                                            KOHL
200   CONTINUE                                                           KOHL
      IF(INY-NU2+NU1-1)300,250,250                                       KOHL
250   WRITE(6,503)A,B                                                    KOHL
300   CONTINUE                                                           KOHL
503   FORMAT(1X,3HA*=,E16.6,10X,3HB*=,E16.6)                             KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE REZE(A1,A2,A3,A4,A5,A6,AR,VOL,IREAL)                    KOHL
      DIMENSION AR(9)                                                    KOHL
      VOL=A1*A2*A3+(A4*A5*A6-A1*A5**2-A2*A6**2-A3*A4**2)/4.              KOHL
      IF(VOL.LE.0.)GO TO 100                                             KOHL
      IF(IREAL)2,4,4                                                     KOHL
2     CONTINUE                                                           KOHL
      VOL=1./VOL                                                         KOHL
      B1=(A2*A3-(A5/2.)**2)*VOL                                          KOHL
      B2=(A1*A3-(A6/2.)**2)*VOL                                          KOHL
      B3=(A2*A1-(A4/2.)**2)*VOL                                          KOHL
      B4=(A5*A6/2.-A3*A4)*VOL                                            KOHL
      B5=(A6*A4/2.-A1*A5)*VOL                                            KOHL
      B6=(A4*A5/2.-A2*A6)*VOL                                            KOHL
      AR(1)=SQRT(B1)                                                     KOHL-CO
      AR(2)=SQRT(B2)                                                     KOHL-CO
      AR(3)=SQRT(B3)                                                     KOHL-CO
      AR(4)=B5/AR(2)/AR(3)/2.                                            KOHL-CO
      AR(5)=B6/AR(3)/AR(1)/2.                                            KOHL-CO
      AR(6)=B4/AR(1)/AR(2)/2.                                            KOHL-CO
      IF(IREAL.EQ.(-2))GO TO 90                                          KOHL-CO
      A1=B1                                                              KOHL-CO
      A2=B2                                                              KOHL-CO
      A3=B3                                                              KOHL-CO
      A4=B4                                                              KOHL-CO
      A5=B5                                                              KOHL-CO
      A6=B6                                                              KOHL-CO
4     CONTINUE                                                           KOHL
5     CONTINUE                                                           KOHL
      IF(A1-A2)15,15,10                                                  KOHL
10    ASP=A1                                                             KOHL
      A1=A2                                                              KOHL
      A2=ASP                                                             KOHL
      ESP=A5                                                             KOHL
      A5=A6                                                              KOHL
      A6=ESP                                                             KOHL
15    CONTINUE                                                           KOHL
      IF(A2-A3)25,25,20                                                  KOHL
20    BSP=A2                                                             KOHL
      A2=A3                                                              KOHL
      A3=BSP                                                             KOHL
      DSP=A4                                                             KOHL
      A4=A6                                                              KOHL
      A6=DSP                                                             KOHL
      GO TO 5                                                            KOHL
25    CONTINUE                                                           KOHL
      IND=1                                                              KOHL
      IF(A4.LT.0.)IND=-IND                                               KOHL
      IF(A5.LT.0.)IND=-IND                                               KOHL
      IF(A6.LT.0.)IND=-IND                                               KOHL
      A44=ABS(A4)                                                        KOHL
      A55=ABS(A5)                                                        KOHL
      A66=ABS(A6)                                                        KOHL
      IF(IND)30,35,35                                                    KOHL
30    A4=-A44                                                            KOHL
      A5=-A55                                                            KOHL
      A6=-A66                                                            KOHL
      GO TO 50                                                           KOHL
35    A4=A44                                                             KOHL
      A5=A55                                                             KOHL
      A6=A66                                                             KOHL
50    CONTINUE                                                           KOHL
      VIND=IND                                                           KOHL
      IF(A44-A1)55,55,52                                                 KOHL
52    A2=A2-A44+A1                                                       KOHL
      A4=A4-2.*A1*VIND                                                   KOHL
      A5=A5-A66                                                          KOHL
      GO TO 5                                                            KOHL
55    IF(A66-A1)60,60,56                                                 KOHL
56    A3=A3-A66+A1                                                       KOHL
      A5=A5-A44                                                          KOHL
      A6=A6-2.*A1*VIND                                                   KOHL
      GO TO 5                                                            KOHL
60    IF(A55-A2)65,65,61                                                 KOHL
61    A3=A3-A55+A2                                                       KOHL
      A5=A5-2.*A2*VIND                                                   KOHL
      A6=A6-A44                                                          KOHL
      GO TO 5                                                            KOHL
65    CONTINUE                                                           KOHL
      IF(IND)67,67,80                                                    KOHL
67    ABA=A1+A2+A4+A5+A6                                                 KOHL
      IF(ABA)69,69,80                                                    KOHL
69    A3=A3+ABA                                                          KOHL
      A5=A5+A4+2*A2                                                      KOHL
      A6=A6+A4+2*A1                                                      KOHL
      GO TO 5                                                            KOHL
80    CONTINUE                                                           KOHL
      IF(IREAL)85,82,82                                                  KOHL
82    CONTINUE                                                           KOHL
      AX1=(A2*A3-(A5/2.)**2)                                             KOHL
      AX2=(A1*A3-(A6/2.)**2)                                             KOHL
      AX3=(A2*A1-(A4/2.)**2)                                             KOHL
      AR(1)=SQRT(AX1/VOL)                                                KOHL
      AR(2)=SQRT(AX2/VOL)                                                KOHL
      AR(3)=SQRT(AX3/VOL)                                                KOHL
      AR(4)=(A6*A4/4.-A1*A5/2.)/SQRT(AX2*AX3)                            KOHL
      AR(5)=(A4*A5/4.-A2*A6/2.)/SQRT(AX3*AX1)                            KOHL
      AR(6)=(A5*A6/4.-A3*A4/2.)/SQRT(AX1*AX2)                            KOHL
      GO TO 90                                                           KOHL
85    CONTINUE                                                           KOHL
 90   CONTINUE                                                           KOHL
      GPI=180./3.141592654                                               KOHL-CO
      AR(7)=ARCOS(AR(4))*GPI                                             KOHL-CO
      AR(8)=ARCOS(AR(5))*GPI                                             KOHL-CO
      AR(9)=ARCOS(AR(6))*GPI                                             KOHL-CO
100   CONTINUE                                                           KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE SORT(I3)                                                KOHL
      COMMON/VS/QP(400),IH(400),IK(400),IL(400)                          KOHL
      MM=I3-1                                                            KOHL
      DO 20 N=1,MM                                                       KOHL
      IF(QP(N).LE.QP(N+1))GO TO 20                                       KOHL
      J=N+1                                                              KOHL
15    TT=QP(J)                                                           KOHL
      ITH=IH(J)                                                          KOHL
      ITK=IK(J)                                                          KOHL
      ITL=IL(J)                                                          KOHL
      QP(J)=QP(J-1)                                                      KOHL
      IH(J)=IH(J-1)                                                      KOHL
      IK(J)=IK(J-1)                                                      KOHL
      IL(J)=IL(J-1)                                                      KOHL
      QP(J-1)=TT                                                         KOHL
      IH(J-1)=ITH                                                        KOHL
      IK(J-1)=ITK                                                        KOHL
      IL(J-1)=ITL                                                        KOHL
      J=J-1                                                              KOHL
      IF(J.LE.0)GO TO 20                                                 KOHL
      IF(QP(J)-QP(J-1))15,20,20                                          KOHL
20    CONTINUE                                                           KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE SORT1(N,ITEM,LM,NMI)                                    KOHL
      DIMENSION ITEM(LM),NEST(14,2)                                      KOHL
      EQUIVALENCE (L1,POINT2),(L2,KLUFT)                                 KOHL
      INTEGER POINT,ALPHA,BETA,POINT1,POINT2                             KOHL
      REAL ITEM,KLUFT,NEST                                               KOHL
      IF(N-NMI+1)1,1,2                                                   KOHL
    1 RETURN                                                             KOHL
    2 POINT=1                                                            KOHL
      ALPHA=NMI                                                          KOHL
      BETA=N                                                             KOHL
    3 KLUFT=ITEM(BETA)                                                   KOHL
      POINT1=ALPHA                                                       KOHL
      POINT2=BETA                                                        KOHL
    4 IF(ITEM(POINT1).GT.KLUFT) GO TO 7                                  KOHL
    5 POINT1=POINT1+1                                                    KOHL
      IF(POINT1.NE.POINT2) GO TO 4                                       KOHL
    6 ITEM(POINT1)=KLUFT                                                 KOHL
      GO TO 9                                                            KOHL
    7 ITEM(POINT2)=ITEM(POINT1)                                          KOHL
    8 POINT2=POINT2-1                                                    KOHL
      IF(POINT1.EQ.POINT2) GO TO 6                                       KOHL
      IF(ITEM(POINT2).GE.KLUFT) GO TO 8                                  KOHL
      ITEM(POINT1)=ITEM(POINT2)                                          KOHL
      GO TO 5                                                            KOHL
    9 L1=POINT1-ALPHA                                                    KOHL
      L2=BETA-POINT1                                                     KOHL
      IF(L1.LT.2) GO TO 13                                               KOHL
      IF(L2.LT.2) GO TO 16                                               KOHL
      IF(L1.GT.L2) GO TO 10                                              KOHL
      NEST(POINT,1)=POINT1+1                                             KOHL
      NEST(POINT,2)=BETA                                                 KOHL
      POINT=POINT+1                                                      KOHL
      GO TO 16                                                           KOHL
   10 NEST(POINT,1)=ALPHA                                                KOHL
      NEST(POINT,2)=POINT1-1                                             KOHL
      POINT=POINT+1                                                      KOHL
   12 ALPHA=POINT1+1                                                     KOHL
      GO TO 3                                                            KOHL
   13 IF(L2.GE.2) GO TO 12                                               KOHL
      POINT=POINT-1                                                      KOHL
      IF(POINT.EQ.0) RETURN                                              KOHL
      ALPHA=NEST(POINT,1)                                                KOHL
      BETA= NEST(POINT,2)                                                KOHL
      GO TO 3                                                            KOHL
   16 BETA=POINT1-1                                                      KOHL
      GO TO 3                                                            KOHL
      END                                                                KOHL
      SUBROUTINE SORT7(N,ITEM,AZ,LM,MM)                                  KOHL
      DIMENSION ITEM(LM),AZ(MM,LM),NEST(13,2),A(6)                       KOHL
      REAL KLUFT,ITEM                                                    KOHL
      INTEGER POINT,ALPHA,BETA,POINT1,POINT2                             KOHL
      IF(N.GE.2)GO TO 2                                                  KOHL
1     RETURN                                                             KOHL
2     POINT=1                                                            KOHL
      ALPHA=1                                                            KOHL
      BETA=N                                                             KOHL
3     KLUFT=ITEM(BETA)                                                   KOHL
      DO 20 I=1,MM                                                       KOHL
20    A(I)=AZ(I,BETA)                                                    KOHL
      POINT1=ALPHA                                                       KOHL
      POINT2=BETA                                                        KOHL
4     IF(ITEM(POINT1).GT.KLUFT)GO TO 7                                   KOHL
5     POINT1=POINT1+1                                                    KOHL
      IF(POINT1.NE.POINT2)GO TO 4                                        KOHL
6     ITEM(POINT1)=KLUFT                                                 KOHL
      DO 21 I=1,MM                                                       KOHL
21    AZ(I,POINT1)=A(I)                                                  KOHL
      GO TO 9                                                            KOHL
7     ITEM(POINT2)=ITEM(POINT1)                                          KOHL
      DO 22 I=1,MM                                                       KOHL
22    AZ(I,POINT2)=AZ(I,POINT1)                                          KOHL
8     POINT2=POINT2-1                                                    KOHL
      IF(POINT1.EQ.POINT2)GO TO 6                                        KOHL
      IF(ITEM(POINT2).GE.KLUFT)GO TO 8                                   KOHL
      ITEM(POINT1)=ITEM(POINT2)                                          KOHL
      DO 23 I=1,MM                                                       KOHL
23    AZ(I,POINT1)=AZ(I,POINT2)                                          KOHL
      GO TO 5                                                            KOHL
9     L1=POINT1-ALPHA                                                    KOHL
      L2=BETA-POINT1                                                     KOHL
      IF(L1.LT.2)GO TO 13                                                KOHL
      IF(L2.LT.2)GO TO 16                                                KOHL
      IF(L1.GT.L2)GO TO 10                                               KOHL
      NEST(POINT,1)=POINT1+1                                             KOHL
      NEST(POINT,2)=BETA                                                 KOHL
      POINT=POINT+1                                                      KOHL
      GO TO 16                                                           KOHL
10    NEST(POINT,1)=ALPHA                                                KOHL
      NEST(POINT,2)=POINT1-1                                             KOHL
      POINT=POINT+1                                                      KOHL
12    ALPHA=POINT1+1                                                     KOHL
      GO TO 3                                                            KOHL
13    IF(L2.GE.2)GO TO 12                                                KOHL
      POINT=POINT-1                                                      KOHL
      IF(POINT.EQ.0)RETURN                                               KOHL
      ALPHA=NEST(POINT,1)                                                KOHL
      BETA=NEST(POINT,2)                                                 KOHL
      GO TO 3                                                            KOHL
16    BETA=POINT1-1                                                      KOHL
      GO TO 3                                                            KOHL
      END                                                                KOHL
      SUBROUTINE UNAB(Q,R,FEHLP,IZE,VKL,ITA)                             KOHL
      DIMENSION Q(50),DX(100),R(500),IQX(100,12)                         KOHL
      COMMON/LSG/AZ(6,500),VVV(500)                                      KOHL
      EQUIVALENCE (AZ(401),DX(1)),(AZ(901),IQX(1))                       KOHL
      QH=Q(1)*25.                                                        KOHL
      IF(IZE.EQ.4)QH=Q(1)*36.                                            KOHL
      DO 10 J=1,12                                                       KOHL
      IF(Q(J)-QH)10,11,11                                                KOHL
10    CONTINUE                                                           KOHL
      NE=12                                                              KOHL
      GO TO 15                                                           KOHL
11    NE=J-1                                                             KOHL
      IF(NE.LT.6)NE=6                                                    KOHL
15    CONTINUE                                                           KOHL
      CALL ITO(Q,NE,3,3,FEHLP,DX,R,MZ,IQX,IZE,VKL,ITA)                   KOHL
      DO 30 II=1,MZ                                                      KOHL
      ISA=0                                                              KOHL
      DO 25 I=1,10                                                       KOHL
      IF(IQX(II,I).EQ.0)GO TO 27                                         KOHL
      ISA=ISA+1                                                          KOHL
25    CONTINUE                                                           KOHL
27    IF(ITA.EQ.0)GO TO 30                                               KOHL
      WRITE(6,206)DX(II),(IQX(II,I),I=1,ISA)                             KOHL
30    CONTINUE                                                           KOHL
      IF(MZ.LT.1)GO TO 150                                               KOHL
      DZ=2000.                                                           KOHL
      DO 120 L3=6,NE                                                     KOHL
      L2M=L3-1                                                           KOHL
      DO 120 L2=5,L2M                                                    KOHL
      L1M=L2-1                                                           KOHL
      DO 120 L1=4,L1M                                                    KOHL
      DXK=0.                                                             KOHL
      IU=1                                                               KOHL
      DO 100 J=1,MZ                                                      KOHL
      DO 55 K=1,9                                                        KOHL
      IV=IQX(J,K)                                                        KOHL
      IF(IV.EQ.3)GO TO 60                                                KOHL
      IF(IV-L1)50,60,50                                                  KOHL
50    IF(IV-L2)51,60,51                                                  KOHL
51    IF(IV-L3)54,60,54                                                  KOHL
54    IF(IQX(J,K+2))55,100,55                                            KOHL
55    CONTINUE                                                           KOHL
60    KS=K+1                                                             KOHL
      DO 70 L=KS,10                                                      KOHL
      IW=IQX(J,L)                                                        KOHL
      IF(IW.EQ.3)GO TO 80                                                KOHL
      IF(IW-L1)61,80,61                                                  KOHL
61    IF(IW-L2)62,80,62                                                  KOHL
62    IF(IW-L3)65,80,65                                                  KOHL
65    IF(IQX(J,L+1))70,100,70                                            KOHL
70    CONTINUE                                                           KOHL
80    IF(DX(J).GT.DXK)DXK=DX(J)                                          KOHL
      IU=-1                                                              KOHL
100   CONTINUE                                                           KOHL
      IF(IU)110,110,130                                                  KOHL
110   IF(DXK-DZ)113,120,120                                              KOHL
113   DZ=DXK                                                             KOHL
      LS1=L1                                                             KOHL
      LS2=L2                                                             KOHL
      LS3=L3                                                             KOHL
      IF(ITA.EQ.0)GO TO 120                                              KOHL
      WRITE(6,207)DZ,LS1,LS2,LS3                                         KOHL
120   CONTINUE                                                           KOHL
      L1=LS1                                                             KOHL
      L2=LS2                                                             KOHL
      L3=LS3                                                             KOHL
130   AQ1=Q(L1)                                                          KOHL
      AQ2=Q(L2)                                                          KOHL
      AQ3=Q(L3)                                                          KOHL
      Q(L1)=Q(4)                                                         KOHL
      Q(L2)=Q(5)                                                         KOHL
      Q(L3)=Q(6)                                                         KOHL
      Q(4)=AQ1                                                           KOHL
      Q(5)=AQ2                                                           KOHL
      Q(6)=AQ3                                                           KOHL
150   WRITE(6,201)(Q(I),I=1,6),DZ                                        KOHL
201   FORMAT(12H0BASELINES  ,8X,3HQ1=,F8.5,5X,3HQ2=,F8.5,5X,3HQ3=,F8.5   KOHL
     1,5X,3HQ4=,F8.5,5X,3HQ5=,F8.5,5X,3HQ6=,F8.5,10X,3HDZ=,F4.1/)        KOHL
206   FORMAT(' DX=',F10.4,10X,'IQX=',10I8)                               KOHL
207   FORMAT(' DZ=',F10.4,10X,'LS =',3I8)                                KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE UNOR(MO1,MO2,MC,MCH)                                    KOHL
      IMPLICIT INTEGER(H)                                                KOHL
      DIMENSION MC(10),F(3),FI(3)                                        KOHL
      COMMON FEL(50),Q(50),MMM,LUFM,FEHLP,ITER/QZ/IQ(9),IQN(9)/OR/IM,NNN KOHL
      DATA F/1.,4.,9./,FI/1.,0.25,0.1111111/                             KOHL
      DO 10 I=1,9                                                        KOHL
10    IQN(I)=0                                                           KOHL
      Q1=Q(1)                                                            KOHL
      Q2=Q(2)                                                            KOHL
      AMI=Q1*0.01                                                        KOHL
      NU1=MO1                                                            KOHL
      NU2=MO2                                                            KOHL
C              A+B FESTGELEGT DURCH H1>=K1                               KOHL
      DO 80 H1=1,3                                                       KOHL
      A=Q1*FI(H1)                                                        KOHL
C                            BERECHNUNG VON A+B FUER K1=0                KOHL
      DO 30 K2=1,3                                                       KOHL
      B=Q2*FI(K2)                                                        KOHL
      CALL QZO(A,B,-1.,NNN,NU1,NU2,0,INX)                                KOHL
      DO 20 H2=1,3                                                       KOHL
      B=Q2-A*F(H2)                                                       KOHL
      B=B*FI(K2)                                                         KOHL
      IF(B-AMI)30,30,15                                                  KOHL
15    CALL QZO(A,B,-1.,NNN,NU1,NU2,0,INX)                                KOHL
20    CONTINUE                                                           KOHL
30    CONTINUE                                                           KOHL
      HK=H1                                                              KOHL
      IF(HK.EQ.3)HK=2                                                    KOHL
      DO 70 K1=1,HK                                                      KOHL
      K2M=K1+1                                                           KOHL
C     BERECHNUNG VON A+B FUER H2.EQ.0 + K1.NE.0                          KOHL
      DO 40 K2=K2M,3                                                     KOHL
      B=Q2*FI(K2)                                                        KOHL
      A=Q1-B*F(K1)                                                       KOHL
      A=A*FI(H1)                                                         KOHL
      IF(A-AMI)40,40,35                                                  KOHL
35    CALL QZO(A,B,-1.,NNN,NU1,NU2,0,INX)                                KOHL
40    CONTINUE                                                           KOHL
      DO 50 H2=1,H1                                                      KOHL
      B=-Q1*F(H2)+Q2*F(H1)                                               KOHL
      DO 45 K2=K2M,3                                                     KOHL
      DELTA=F(H1)*F(K2)-F(H2)*F(K1)                                      KOHL
      B=B/DELTA                                                          KOHL
      IF(B.LT.AMI)GO TO 45                                               KOHL
      A=(Q1*F(K2)-Q2*F(K1))/DELTA                                        KOHL
      IF(A.LT.AMI)GO TO 45                                               KOHL
      CALL QZO(A,B,-1.,NNN,NU1,NU2,0,INX)                                KOHL
45    CONTINUE                                                           KOHL
50    CONTINUE                                                           KOHL
      IF(H1-3)52,70,70                                                   KOHL
52    H2M=H1+1                                                           KOHL
C                     BERECHNUNG VON A+B FUER H2.GT.H1                   KOHL
      DO 60 H2=H2M,3                                                     KOHL
      A=Q2*FI(H2)                                                        KOHL
      B=Q1-A*F(H1)                                                       KOHL
      IF(B.LT.AMI)GO TO 53                                               KOHL
      B=B*FI(K1)                                                         KOHL
      CALL QZO(A,B,-1.,NNN,NU1,NU2,0,INX)                                KOHL
53    B=-Q1*F(H2)+Q2*F(H1)                                               KOHL
      DO 55 K2=1,3                                                       KOHL
      DELTA=F(H1)*F(K2)-F(H2)*F(K1)                                      KOHL
      IF(ABS(DELTA).LT.0.5)GO TO 55                                      KOHL
      B=B/DELTA                                                          KOHL
      IF(B.LT.AMI)GO TO 55                                               KOHL
      A=(Q1*F(K2)-Q2*F(K1))/DELTA                                        KOHL
      IF(A.LT.AMI)GO TO 55                                               KOHL
      CALL QZO(A,B,-1.,NNN,NU1,NU2,0,INX)                                KOHL
55    CONTINUE                                                           KOHL
60    CONTINUE                                                           KOHL
70    CONTINUE                                                           KOHL
80    CONTINUE                                                           KOHL
      IF(INX-NU2+NU1-1)85,84,84                                          KOHL
84    WRITE(6,500)NU2                                                    KOHL
      MCH=2                                                              KOHL
      MC(1)=NU2-1                                                        KOHL
      MC(2)=NU2                                                          KOHL
      RETURN                                                             KOHL
85    DO 90 J=NU1,NU2                                                    KOHL
      IF(IQN(J))90,88,90                                                 KOHL
88    MCH=1                                                              KOHL
      MC(1)=J                                                            KOHL
      RETURN                                                             KOHL
90    CONTINUE                                                           KOHL
      DO 100 J=1,INX                                                     KOHL
      JJ=IQ(J)                                                           KOHL
      IF(IQN(JJ).EQ.1)GO TO 110                                          KOHL
100   CONTINUE                                                           KOHL
      J1=0                                                               KOHL
      J2=NU1-1                                                           KOHL
102   J1=J1+1                                                            KOHL
      J2=J2+1                                                            KOHL
      MC(J1)=J2                                                          KOHL
      IF(J2-NU2)102,103,103                                              KOHL
103   CONTINUE                                                           KOHL
      MCH=J1                                                             KOHL
      RETURN                                                             KOHL
110   DO 116  J=NU1,NU2                                                  KOHL
      DO 114 L=1,INX                                                     KOHL
      IF(IQ(L).EQ.J)GO TO 116                                            KOHL
114   CONTINUE                                                           KOHL
      MCH=2                                                              KOHL
      MC(1)=JJ                                                           KOHL
      MC(2)=J                                                            KOHL
      GO TO 120                                                          KOHL
116   CONTINUE                                                           KOHL
120   CONTINUE                                                           KOHL
500   FORMAT(1H0,9HTHE FIRST,I2,51H D-VALUES CAN BE ASSIGNED TO A COMMON KOHL
     + LATTICE PLANE)                                                    KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE UNMON(Q,FEHLS,W,IRUN)                                   KOHL
      REAL K1,K2                                                         KOHL
      DIMENSION  HK(2,30),H2(30),K2(30),WK(10),                          KOHL
     +Q(50), G1(3), G2(3),RA(9),IHY(9)                                   KOHL
      DIMENSION IG(84)                                                   KOHL
      COMMON /QUAD/IG                                                    KOHL
      DATA                                   G1/1.,.25,1./,G2/1.,1.,.25/ KOHL
      DATA  HK/ 1.,0.,1.,0.,1.,0.,1.,0.,1.,0.,1.,0.,1.,0.,1.,0.          KOHL
     A,4.,0.,4.,0.,4.,0.,4.,0.,4.,0.,4.,0.,4.,0.,4.,0., 10*1., 4.,1.,    KOHL
     B 4.,1.,4.,1.,4.,1.,4.,1.,4.,1., 4.,2.,4.,2.,4.,2./                 KOHL
      DATA H2/0.,1.,4.,9.,0.,1.,4.,9.,0.,1.,4.,9.,0.,1.,4.,9.,
     1       4.,9.,4.,9.,3*9.,0.,1.,4.,4*9./                             KOHL
      DATA K2/4*1.,4*4.,4*1.,4*4.,0.,0.,1.,1.,4.,0.,1.,4*4.,0.,1.,4./    KOHL
      DATA PI4,PI2/0.7854,1.5708/                                        KOHL
      KZ=0                                                               KOHL
      FEHL=FEHLS                                                         KOHL
      IF(IRUN.LE.0)GO TO 20                                              KOHL
      IF(Q(5).GT.Q(1))GO   TO 4                                          KOHL
      QZW=Q(5)                                                           KOHL
      Q(5)=Q(12)                                                         KOHL
      Q(12)=QZW                                                          KOHL
4     CONTINUE                                                           KOHL
      CALL SORT1(11,Q,50,1)                                              KOHL
      NS=11                                                              KOHL
      DO 5 I=3,10                                                        KOHL
      IF(ABS(Q(I)-QS).LE.0.0000001)NS=I                                  KOHL
5     CONTINUE                                                           KOHL
      GO TO 20                                                           KOHL
10    CONTINUE                                                           KOHL
C     MINDESTENS 6 DER ERSTEN 9  LINIEN LIEGEN AUF RECHTECKNETZ          KOHL
C     Q(1) WIRD AUS BASISLISTE GESTRICHEN                                KOHL
      DO 11 I=1,IHZ                                                      KOHL
      IY=IHY(I)                                                          KOHL
11    RA(I)=Q(IY)                                                        KOHL
      WRITE(6,2000)Q(1),Q(2),(RA(I),I=1,IHZ)                             KOHL
      WRITE(6,2001)A,B                                                   KOHL
      KZ=1                                                               KOHL
      QZW=Q(1)                                                           KOHL
      DO 12 I=1,11                                                       KOHL
12    Q(I)=Q(I+1)                                                        KOHL
      Q(12)=QZW                                                          KOHL
      FEHL=FEHL/1.5                                                      KOHL
20    CONTINUE                                                           KOHL
C     ERSTELLEN VON RECHTECKNETZEN ZU DEN ERSTEN BEIDEN Q-WERTEN         KOHL
      KX=1                                                               KOHL
      KY=2                                                               KOHL
      KS=3                                                               KOHL
      DO 25 I=1,9                                                        KOHL
      WK(I)=1.                                                           KOHL
25    RA(I)=1.                                                           KOHL
      Q12=1./(Q(1)*Q(2))                                                 KOHL
      DO 52 KW=1,3                                                       KOHL
      Q1=Q(KX)                                                           KOHL
      Q2=Q(KY)                                                           KOHL
      DO 50 J= 1,30                                                      KOHL
      H1=HK(1,J)                                                         KOHL
      K1=HK(2,J)                                                         KOHL
      DE=H1*K2(J)-H2(J)*K1                                               KOHL
      DE=1./DE                                                           KOHL
      A=(K2(J)*Q1-K1*Q2)*DE                                              KOHL
      B=(-H2(J)*Q1+H1*Q2)*DE                                             KOHL
      IF(A.LE.0..OR.B.LE.0.)GO TO 50                                     KOHL
      IF (B.GT.A)GO TO 30                                                KOHL
      C=A                                                                KOHL
      A=B                                                                KOHL
      B=C                                                                KOHL
30    CONTINUE                                                           KOHL
      AI=1./A                                                            KOHL
      X=B*AI                                                             KOHL
C     INDIZIERUNG DER Q-WERTE  Q3....Q8  IN DEN 30 RECHTECKNETZEN        KOHL
C     ZUORDNUNG VON  RANGWERTEN JE NACH NETZART BEI ERFOLGREICHER INDIZ  KOHL
      IHZ=0                                                              KOHL
      AB2=(A+B)*0.5                                                      KOHL
      REI=1./SQRT(A*B)                                                   KOHL
      PIF=PI4*REI                                                        KOHL
      ABF=AB2*REI                                                        KOHL
      PR=1.                                                              KOHL
      RE=A*B*Q12                                                         KOHL
      DO 41 K=KS,9                                                       KOHL
      EPS =Q(K)*FEHL                                                     KOHL
      EPS2=EPS+EPS                                                       KOHL
      QQ=Q(K)+EPS                                                        KOHL
      EP=EPS2*AI                                                         KOHL
      F=QQ*AI+2.                                                         KOHL
      IF(F.GE.81.)GO TO 41                                               KOHL
      S=1.                                                               KOHL
35    CONTINUE                                                           KOHL
      F2=F-EP                                                            KOHL
      I2=F2                                                              KOHL
      I1=F                                                               KOHL
      IF(IG(I1)-IG(I2))38,36,38                                          KOHL
36    F=F-X*S                                                            KOHL
      S=S+2.                                                             KOHL
      IF(F-2.)41,35,35                                                   KOHL
38    CONTINUE                                                           KOHL
      PRK=EPS*(PIF+ABF/SQRT(Q(K)))                                       KOHL
      PR=PR*(1.-PRK)/PRK                                                 KOHL
      IHZ=IHZ+1                                                          KOHL
      IHY(IHZ)=K                                                         KOHL
41    CONTINUE                                                           KOHL
      IF(IHZ.LE.0)GO TO 50                                               KOHL
      IF(IRUN.LE.0)GO TO 44                                              KOHL
      DO 43 I=1,IHZ                                                      KOHL
      IF(IHY(I).EQ.NS)GO TO 44                                           KOHL
43    CONTINUE                                                           KOHL
      GO TO 50                                                           KOHL
44    CONTINUE                                                           KOHL
      PR=PR*RE                                                           KOHL
      DO 45 I=1,IHZ                                                      KOHL
      IY=IHY(I)                                                          KOHL
      IF(PR.GT.RA(IY))RA(IY)=PR                                          KOHL
45    CONTINUE                                                           KOHL
      IF(IHZ.LT.6)GO TO 50                                               KOHL
      IF(KZ.LE.0)GO TO 10                                                KOHL
      IF(IHZ.EQ.6)GO TO 56                                               KOHL
      QZW=Q(3)                                                           KOHL
      Q(3)=Q(8)                                                          KOHL
      Q(8)=QZW                                                           KOHL
      IR=3                                                               KOHL
      GO TO 59                                                           KOHL
50    CONTINUE                                                           KOHL
      IF(KW.NE.1)GO TO 51                                                KOHL
56    CONTINUE                                                           KOHL
      LAR=3                                                              KOHL
      ARA=RA(3)                                                          KOHL
      DO 58 I=4,9                                                        KOHL
      IF(RA(I).GE.ARA)GO TO 58                                           KOHL
      LAR=I                                                              KOHL
      ARA=RA(I)                                                          KOHL
58    CONTINUE                                                           KOHL
      RZW=RA(3)                                                          KOHL
      QZW=Q(3)                                                           KOHL
      Q(3)=Q(LAR)                                                        KOHL
      RA(3)=RA(LAR)                                                      KOHL
      Q(LAR)=QZW                                                         KOHL
      RA(LAR)=RZW                                                        KOHL
      IF(IHZ.LT.6)GO TO 51                                               KOHL
      IR=4                                                               KOHL
59    WRITE(6,2000)(Q(I),I=IR,9)                                         KOHL
      WRITE(6,2001)A,B                                                   KOHL
      J=9                                                                KOHL
      RAM=RA(9)                                                          KOHL
      GO TO 110                                                          KOHL
51    CONTINUE                                                           KOHL
      KS=4                                                               KOHL
      IF(KY.EQ.3)KX=2                                                    KOHL
      IF(KY.NE.3)KY=3                                                    KOHL
52    CONTINUE                                                           KOHL
      Q1=Q(1)                                                            KOHL
      Q2=Q(2)                                                            KOHL
      RA(1)=-3.                                                          KOHL
      RA(2)=-2.                                                          KOHL
C     ERMITTLUNG DES GUENSTIGSTEN Q-WERTES QX                            KOHL
C     ERSTELLUNG SCHIEFWINKELIGER NETZE ZU DEN Q-WERTEN Q1,Q2,QX.        KOHL
      M=0                                                                KOHL
      DO 70 J=1,3                                                        KOHL
      AA=Q1*G1(J)                                                        KOHL
      BB=Q2*G2(J)                                                        KOHL
      SK=0.                                                              KOHL
60    SK=SK+1.                                                           KOHL
      Y=Q(3)-BB*SK*SK                                                    KOHL
      SH=0.                                                              KOHL
62    SH=SH+1.                                                           KOHL
      A=AA                                                               KOHL
      B=BB                                                               KOHL
      D=(Y-AA*SH*SH)/(SH*SK)                                             KOHL
      Z=A*B-0.25*D*D                                                     KOHL
      IF(Z.LE.0.)GO TO 71                                                KOHL
C     REDUKTION DES EBENEN GITTERS                                       KOHL
      D=ABS(D)                                                           KOHL
64    IF(A-B)66,66,65                                                    KOHL
65    X=A                                                                KOHL
      A=B                                                                KOHL
      B=X                                                                KOHL
66    IF(A-D)67,69,69                                                    KOHL
67    B=B-D+A                                                            KOHL
      D=ABS(D-2.*A)                                                      KOHL
      GO TO 64                                                           KOHL
69    CONTINUE                                                           KOHL
C     INDIZIERUNG DER Q-WERTE Q4...Q8 MIT DEN     SCHIEFW. NETZEN.       KOHL
      PR=1.                                                              KOHL
      IHZ=0                                                              KOHL
      REI=1./SQRT(Z)                                                     KOHL
      PIF=PI2*REI                                                        KOHL
      ABF=(A+B)*0.5*REI                                                  KOHL
      DO 95 K=4,9                                                        KOHL
      QQ=Q(K)                                                            KOHL
      EPS=FEHL*QQ                                                        KOHL
      QS=QQ+EPS                                                          KOHL
      IF(Z*625.0.LT.QS*QS)GO TO 95                                       KOHL
      EPS2=EPS+EPS                                                       KOHL
      F=QS                                                               KOHL
      FK2M=F*A/Z                                                         KOHL
      FK=0.                                                              KOHL
77    CONTINUE                                                           KOHL
      F1=F-B*FK*FK                                                       KOHL
      IF(F1)89,78,78                                                     KOHL
78    IF(F1-EPS2)97,97,79                                                KOHL
79    F2=D*FK                                                            KOHL
      F3=F2                                                              KOHL
      H=1.                                                               KOHL
80    CONTINUE                                                           KOHL
      F6=F1-A*H*H-F3                                                     KOHL
      IF(F6)84,81,81                                                     KOHL
81    IF(F6-EPS2)97,97,82                                                KOHL
82    H=H+1.                                                             KOHL
      F3=F3+F2                                                           KOHL
      GO TO 80                                                           KOHL
84    IF(F2)87,87,85                                                     KOHL
85    F3=-F3                                                             KOHL
      F2=-F2                                                             KOHL
      GO TO 80                                                           KOHL
87    FK=FK+1.                                                           KOHL
      GO  TO 77                                                          KOHL
89    IF(F-Z/A*FK*FK)95,95,90                                            KOHL
90    F6=F1                                                              KOHL
      H=0.                                                               KOHL
91    H=H+1.                                                             KOHL
      F7=F1+(D*FK-A*H)*H                                                 KOHL
      IF(F7.LT.F6.AND.F6.LT.0.)GO TO 87                                  KOHL
      F6=F7                                                              KOHL
      IF(F6)91,97,92                                                     KOHL
92    IF(F6-EPS2)97,97,91                                                KOHL
C     ZUORDNUNG VON WAHRSCHEINLICHKEITSWERTEN FUER ERFOLGREICHE INDIZ.   KOHL
97    CONTINUE                                                           KOHL
      PRK=EPS*(PIF+ABF/SQRT(QQ  ))                                       KOHL
      PR=PR*(1.-PRK)/PRK                                                 KOHL
      IHZ=IHZ+1                                                          KOHL
      IHY(IHZ)=K                                                         KOHL
95    CONTINUE                                                           KOHL
      IF(IHZ.LE.0)GO TO 100                                              KOHL
      PR=PR*Z*Q12                                                        KOHL
      DO 98 I=1,IHZ                                                      KOHL
      IY=IHY(I)                                                          KOHL
      IF(PR.GT.WK(IY))WK(IY)=PR                                          KOHL
98    CONTINUE                                                           KOHL
100   CONTINUE                                                           KOHL
71    CONTINUE                                                           KOHL
      IF(SH.LT.2.9)GOTO 62                                               KOHL
      IF(SK.LT.2.9)GOTO 60                                               KOHL
70    CONTINUE                                                           KOHL
      DO 105 J=4,9                                                       KOHL
105   RA(J)=RA(J)+WK(J)                                                  KOHL
      RAM=RA(4)                                                          KOHL
      J=4                                                                KOHL
      DO 108 I=5,9                                                       KOHL
      IF(RA(I)-RAM)107,108,108                                           KOHL
107   RAM=RA(I)                                                          KOHL
      J=I                                                                KOHL
108   CONTINUE                                                           KOHL
110   CONTINUE                                                           KOHL
      X=Q(4)                                                             KOHL
      Q(4)=Q(J)                                                          KOHL
      Q(J)=X                                                             KOHL
      QS=Q(4)                                                            KOHL
      W=RAM+RA(3)                                                        KOHL
      W=ALOG(W)                                                          KOHL
      CALL SORT1(4,Q,50,1)                                               KOHL
2000  FORMAT(79H0THE LINES WITH FOLLOWING Q-VALUES CAN BE ASSIGNED TO A  KOHL
     1COMMON RECTANGULAR NET  /5X,10F10.5)                               KOHL
2001  FORMAT(26H RECIPROCAL NET PARAMETERS,10X,2HA=,F10.6,5X,2HB=,F10.6) KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE VGR(QN,V1Z,VD1Z,NZMAX,VM,FEHL,ISYS,VK,VG,JV)            KOHL
      DIMENSION  VG(10),VK(10),FF(6)                                     KOHL
      DATA FF/0.15,0.22,0.53,1.05,2.1,2.1/                               KOHL
      FA=4.                                                              KOHL
      IF(ISYS.LE.4)FA=6.                                                 KOHL
      VH=FA*20./(QN*SQRT(QN)*FF(ISYS))                                   KOHL
      IF(V1Z.GT.0.)GO TO 10                                              KOHL
      VMI=VM                                                             KOHL
      VMA=VH                                                             KOHL
      NZMI=1                                                             KOHL
      NZMA=1                                                             KOHL
      GO TO 11                                                           KOHL
10    VD=VD1Z+1.5*V1Z*FEHL                                               KOHL
      VMI=V1Z-VD                                                         KOHL
      VMA=V1Z+VD                                                         KOHL
      ZMI=VM/VMA                                                         KOHL
      NZMI=ZMI+1.                                                        KOHL
      L=NZMAX-NZMI+1                                                     KOHL
      IF(L.GT.10)NZMAX=10+NZMI-1                                         KOHL
      NZMA=VH/VMI                                                        KOHL
      IF(NZMA.GT.NZMAX)NZMA=NZMAX                                        KOHL
11    CONTINUE                                                           KOHL
      JV=NZMA-NZMI+1                                                     KOHL
      J=JV+1                                                             KOHL
      WRITE(6,200)                                                       KOHL
      DO 12 I=NZMI,NZMA                                                  KOHL
      BI=I                                                               KOHL
      J=J-1                                                              KOHL
      V1=BI*VMI                                                          KOHL
      V2=BI*VMA                                                          KOHL
      WRITE(6,201)V1,V2                                                  KOHL
      VK(J)=1./V2**2                                                     KOHL
12    VG(J)=1./V1**2                                                     KOHL
200   FORMAT(1H0,14H VOLUME RANGES)                                      KOHL
201   FORMAT(1X,F15.3,6H .....,F9.3)                                     KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE VERG(IDA,IOR)                                           KOHL
      REAL IQW,I20                                                       KOHL
      DIMENSION AR(9),Q(50),AK(6),AKM(6),P(50),F(50,6),E(50,6),          KOHL
     1HX(4,2),KX(4,2),LX(4,2),IRE(4),PP(50)                              KOHL
      COMMON FEL(50),QAN(50),NNN,LUFM,FEP,ITER/SCHR/TEXT(20),IQW,I20,NQW KOHL
     1,ITEST,QN,WLENG                                                    KOHL-CO
     1/LSG/AZ(6,500),VVV(500)                                            KOHL
     1/VQ/PF(50),LH(50),LK(50),LL(50),PF2(50)                            KOHL
     1,LH2(50),LK2(50),LL2(50),PFA(50)/VS/QP(400),IH(400),IK(400)        KOHL
     2,IL(400)/CQS/QS(2)                                                 KOHL
      COMMON /BEST/WMB                                                   KOHL
      INTEGER H1                                                         KOHL
C---FOR USE WITH REFINE FILE FACILITY (ULCC)                             KOHLRFC
      DIMENSION TITLE(20)                                                KOHLRFC
      EQUIVALENCE (TITLE(1),TEXT(1)),(NOBS,NNN)                          KOHLRFC
      COMMON /REFCOM/ AMOLWT,DOBS,NSOL,ITEMCH,IREFCH                     KOHLRFC
C---QCELL IS FOR PASSING SOLUTIONS TO S/R REFINC (ULCC)                  REFQCEL
      DIMENSION QCELL(6)                                                 REFQCEL
      GPI=360./3.141592654                                               KOHL-CO
      WRITE(6,206)IDA                                                    KOHL
      IDS1=6                                                             KOHL
      IDS2=2                                                             KOHL
      WMS1=0                                                             KOHL
      WMS2=0.                                                            KOHL
      MMAX=20                                                            KOHL
      IF(NNN.LT.20)MMAX=NNN                                              KOHL
      DO 5 I=1,IOR                                                       KOHL
      Q(I)=QAN(I)                                                        KOHL
5     PFA(I)=-100000.                                                    KOHL
      IF(IOR.LE.4)GO TO 4                                                KOHL
      Q(1)=QS(1)                                                         KOHL
      Q(2)=QS(2)                                                         KOHL
4     CONTINUE                                                           KOHL
      IORE=IOR+1                                                         KOHL
      DO 10 I=IORE,NNN                                                   KOHL
      Q(I)=QAN(I)                                                        KOHL
10    PFA(I)=-10000.                                                     KOHL
      QWF=QN                                                             KOHL
      CALL SORT7(NNN,Q,PFA,50,1)                                         KOHL
      QRZ=1.1*Q(NNN)                                                     KOHL
      IF(ITEST.EQ.0)GO TO 25                                             KOHL
      WRITE(6,221)                                                       KOHL
      DO 20 I=1,IDA                                                      KOHL
      VOL=1./VVV(I)                                                      KOHL
      VOL=SQRT(VOL)                                                      KOHL
20    WRITE(6,201)(AZ(J,I),J=1,6),VOL                                    KOHL
25    CONTINUE                                                           KOHL
      DO 180 ID=1,IDA                                                    KOHL
      FEHLP=FEP                                                          KOHL
      IT=1                                                               KOHL
      IREAL=1                                                            KOHL
      J1=6                                                               KOHL
      AA1=AZ(1,ID)                                                       KOHL
      IF(AA1.EQ.0)GO TO 180                                              KOHL
      AA2=AZ(2,ID)                                                       KOHL
      AA3=AZ(3,ID)                                                       KOHL
      AA4=AZ(4,ID)                                                       KOHL
      AA5=AZ(5,ID)                                                       KOHL
      AA6=AZ(6,ID)                                                       KOHL
      A1=AA1                                                             KOHL
      A2=AA2                                                             KOHL
      A3=AA3                                                             KOHL
      A4=AA4                                                             KOHL
      A5=AA5                                                             KOHL
      A6=AA6                                                             KOHL
30    CONTINUE                                                           KOHL
      DO 40 I=1,NNN                                                      KOHL
40    FEL(I)=Q(I)*FEHLP                                                  KOHL
      CALL QERZ(A1,A2,A3,A4,A5,A6,QRZ,399,MONO,Q,NNN,P,IRM,1,1,IW,QWF,   KOHL
     1IV)                                                                KOHL
      IF(IRM.LT.J1.AND.IT.GT.1)GO TO 88                                  KOHL
      JF=0                                                               KOHL
      DO 46J=1,IRM                                                       KOHL
      IF(PF2(J)+99.)45,46,46                                             KOHL
45    JF=JF+1                                                            KOHL
46    CONTINUE                                                           KOHL
      J=0                                                                KOHL
      IF(IRM-J1)50,50,48                                                 KOHL
48    J1=IRM                                                             KOHL
      AMV=1000000.                                                       KOHL
50    NLG=JF                                                             KOHL
      JAZ=0                                                              KOHL
      IF(JF-4)86,86,54                                                   KOHL
54    DO 57 JS=1,IRM                                                     KOHL
      IF(PF2(JS)+99.)56,57,57                                            KOHL
56    CONTINUE                                                           KOHL
      J=J+1                                                              KOHL
      H1=LH(JS)                                                          KOHL
      K1=LK(JS)                                                          KOHL
      L1=LL(JS)                                                          KOHL
      F(J,1)=H1**2                                                       KOHL
      F(J,2)=K1**2                                                       KOHL
      F(J,3)=L1**2                                                       KOHL
      F(J,4)=H1*K1                                                       KOHL
      F(J,5)=K1*L1                                                       KOHL
      F(J,6)=L1*H1                                                       KOHL
      PP(J)=P(JS)                                                        KOHL
57    CONTINUE                                                           KOHL
      IF(JF.LE.8)GO TO 105                                               KOHL
61    CONTINUE                                                           KOHL
      CALL MAUS(PP,F,IOR,J,AK,AKM,VT1,AM)                                KOHL
      JAF=0                                                              KOHL
      IF(J.LT.0)GO TO 60                                                 KOHL
      A1=AK(1)                                                           KOHL
      A2=AK(2)                                                           KOHL
      A3=AK(3)                                                           KOHL
      A4=AK(4)                                                           KOHL
      A5=AK(5)                                                           KOHL
      A6=AK(6)                                                           KOHL
62    CONTINUE                                                           KOHL
      CALL QERZ(A1,A2,A3,A4,A5,A6,QRZ,399,MON ,Q,NNN,P,IRM,1,1,IW,QWF,   KOHL
     1IV)                                                                KOHL
63     CONTINUE                                                          KOHL
      IF(IRM.GE.J1)GO TO 64                                              KOHL
60    IF(JAZ.GT.0.AND.JAZ.LT.JVG)GO TO 135                               KOHL
      IF(JAF.GT.0)GO TO 88                                               KOHL
      JAF=1                                                              KOHL
      A1=AA1                                                             KOHL
      A2=AA2                                                             KOHL
      A3=AA3                                                             KOHL
      A4=AA4                                                             KOHL
      A5=AA5                                                             KOHL
      A6=AA6                                                             KOHL
      GO TO 62                                                           KOHL
64    CONTINUE                                                           KOHL
      DO 69 I=1,IRM                                                      KOHL
      H1=LH(I)                                                           KOHL
      K1=LK(I)                                                           KOHL
      L1=LL(I)                                                           KOHL
      E(I,1)=H1**2                                                       KOHL
      E(I,2)=K1**2                                                       KOHL
      E(I,3)=L1**2                                                       KOHL
      E(I,4)=H1*K1                                                       KOHL
      E(I,5)=K1*L1                                                       KOHL
      E(I,6)=L1*H1                                                       KOHL
69    CONTINUE                                                           KOHL
      J=IRM                                                              KOHL
      CALL MAUS(P,E,MON,J,AK,AKM,VT1,AM)                                 KOHL
      IF(MON-4)72,72,74                                                  KOHL
72    AM=0.5*AM                                                          KOHL
74    IF(AM-AMV)75,78,78                                                 KOHL
75    IF(J.LT.J1)GO TO 78                                                KOHL
      AMV=AM                                                             KOHL
      AA1=AK(1)                                                          KOHL
      AA2=AK(2)                                                          KOHL
      AA3=AK(3)                                                          KOHL
      AA4=AK(4)                                                          KOHL
      AA5=AK(5)                                                          KOHL
      AA6=AK(6)                                                          KOHL
78    IF(JAZ.GT.0)GO TO 135                                              KOHL
79    CONTINUE                                                           KOHL
      A1=AA1                                                             KOHL
      A2=AA2                                                             KOHL
      A3=AA3                                                             KOHL
      A4=AA4                                                             KOHL
      A5=AA5                                                             KOHL
      A6=AA6                                                             KOHL
      IF(IT-ITER)86,88,88                                                KOHL
86    FEHLP=FEHLP*0.8                                                    KOHL
      IT=IT+1                                                            KOHL
      GO TO 30                                                           KOHL
88    CONTINUE                                                           KOHL
      CALL QERZ(A1,A2,A3,A4,A5,A6,QRZ,399,MON ,Q,NNN,P,IRM,2,1,IW,QWF,   KOHL
     1IV)                                                                KOHL
      BMV=0.                                                             KOHL
      DO 92 I=1,IRM                                                      KOHL
92    BMV=BMV+PF(I)                                                      KOHL
      BMV=BMV/IRM                                                        KOHL
      WM20=QWF/(2.*BMV*IV)                                               KOHL
      IF(WM20.LT.IQW)GO TO 180                                           KOHL
      AZ(1,ID)=A1                                                        KOHL
      AZ(2,ID)=A2                                                        KOHL
      AZ(3,ID)=A3                                                        KOHL
      AZ(4,ID)=A4                                                        KOHL
      AZ(5,ID)=A5                                                        KOHL
      AZ(6,ID)=A6                                                        KOHL
      DO 90 I=1,6                                                        KOHL
      IF(ABS(AZ(I,ID)-AZ(I,IDS1)).GT.ABS(AZ(I,ID)*0.02))GO TO 91         KOHL
90    CONTINUE                                                           KOHL
      IF(WM20.LE.WMS1*1.005)GO TO 180                                    KOHL
91    DO 93 I=1,6                                                        KOHL
      IF(ABS(AZ(I,ID)-AZ(I,IDS2)).GT.ABS(AZ(I,ID)*0.02))GO TO 94         KOHL
93    CONTINUE                                                           KOHL
      IF(WM20.LE.WMS2*1.005)GO TO 180                                    KOHL
94    CONTINUE                                                           KOHL
      IDS1=IDS2                                                          KOHL
      IDS2=ID                                                            KOHL
      WMS1=WMS2                                                          KOHL
      WMS2=WM20                                                          KOHL
      IF(WM20.GT.WMB)WMB=WM20                                            KOHL
      IREAL=-2                                                           KOHL-CO
      CALL REZE(A1,A2,A3,A4,A5,A6,AR,VOL,IREAL)                          KOHL
      IF(VOL.LE.0.)GO TO 180                                             KOHL
      NSOL1=NSOL+1                                                       KOHLREF
      WRITE(6,204) NSOL1                                                 KOHLREF
C---STORE SOLUTION FOR SUBSEQUENT COPYING TO REFINE FILE (ULCC)          KOHLREF
C---N.B. ANGLE CONSTANTS STORED BY KOHL IN THE ORDER F,D,E               KOHLREF
      QCELL(1)=10000.*A1                                                 KOHLREF
      QCELL(2)=10000.*A2                                                 KOHLREF
      QCELL(3)=10000.*A3                                                 KOHLREF
      QCELL(4)=10000.*A5                                                 KOHLREF
      QCELL(5)=10000.*A6                                                 KOHLREF
      QCELL(6)=10000.*A4                                                 KOHLREF
      CALL REFINC(QCELL)                                                 KOHLREF
      WRITE(6,205)                                                       KOHL
      VOL2=SQRT(VOL)                                                     KOHL
      WRITE(6,202)(AR(I),I=1,3),(AR(I),I=7,9),VOL2,AMV,WM20,IV           KOHL
      IF(WM20.LT.I20)GO TO 180                                           KOHL
      WRITE(6,230)                                                       KOHL
      DO 95 I=1,IRM                                                      KOHL
      IF(MON.LE.3)LH(I)=IABS(LH(I))                                      KOHL
      DWE=1./SQRT(P(I))                                                  KOHL
      WRITE(6,229)I,DWE,P(I),PF(I),LH(I),LK(I),LL(I)                     KOHL-CO
      IF(WLENG.LE.0.)GO TO 95                                            KOHL-CO
      QC=A1*LH(I)**2+A2*LK(I)**2+A3*LL(I)**2+A4*LH(I)*LK(I)              KOHL-CO
     1+A5*LK(I)*LL(I)+A6*LL(I)*LH(I)                                     KOHL-CO
      THETAC=ASIN(WLENG*SQRT(QC)*0.5)*GPI                                KOHL-CO
      THETAO=ASIN(WLENG*SQRT(P(I))*0.5)*GPI                              KOHL-CO
      DELTHE=THETAO-THETAC                                               KOHL-CO
      WRITE(6,231)THETAO,DELTHE                                          KOHL-CO
95    CONTINUE                                                           KOHL-CO
      CALL SORT(IW)                                                      KOHL
      IF(MON.GE.4)GO TO 98                                               KOHL
      DO 97 I=1,NQW                                                      KOHL
97    IH(I)=IABS(IH(I))                                                  KOHL
98    CONTINUE                                                           KOHL
      WRITE(6,216)                                                       KOHL-3
      WRITE(6,227)                                                       KOHL
      IPS=(NQW+4)/5                                                      KOHL
      DO 100 J=1,IPS                                                     KOHL
      J1=J+IPS                                                           KOHL
      J2=J+2*IPS                                                         KOHL
      J3=J+3*IPS                                                         KOHL
      J4=J+4*IPS                                                         KOHL
      WRITE(6,217)QP(J),IH(J),IK(J),IL(J),QP(J1),IH(J1),IK(J1),IL(J1),   KOHL
     1QP(J2),IH(J2),IK(J2),IL(J2),QP(J3),IH(J3),IK(J3),IL(J3),           KOHL
     2QP(J4),IH(J4),IK(J4),IL(J4)                                        KOHL
100   CONTINUE                                                           KOHL
      GO TO 180                                                          KOHL
105   CONTINUE                                                           KOHL
      JF9=9-JF                                                           KOHL
      JVG=2**JF9                                                         KOHL
      DO 110 I=1,JF9                                                     KOHL
110   IRE(I)=1                                                           KOHL
      JAZ=0                                                              KOHL
      JWM=IRM+1                                                          KOHL
      JT=1                                                               KOHL
      DO 130 JW=1,IRM                                                    KOHL
      JS=JWM-JW                                                          KOHL
      IF(PF2(JS))130,130,120                                             KOHL
120   CONTINUE                                                           KOHL
      IB=JF+JT                                                           KOHL
      PP(IB)=P(JS)                                                       KOHL
      HX(JT,1)=LH(JS)                                                    KOHL
      KX(JT,1)=LK(JS)                                                    KOHL
      LX(JT,1)=LL(JS)                                                    KOHL
      HX(JT,2)=LH2(JS)                                                   KOHL
      KX(JT,2)=LK2(JS)                                                   KOHL
      LX(JT,2)=LL2(JS)                                                   KOHL
      JT=JT+1                                                            KOHL
      IF(JT-JF9)130,130,135                                              KOHL
130   CONTINUE                                                           KOHL
      NLG=-JF                                                            KOHL
      MON=MONO                                                           KOHL
      GO TO 63                                                           KOHL
135   CONTINUE                                                           KOHL
      JAZ=JAZ+1                                                          KOHL
      IF(JAZ.GT.JVG)GO TO 79                                             KOHL
      DO 160 JT=1,JF9                                                    KOHL
      IR=IRE(JT)                                                         KOHL
      H1=HX(JT,IR)                                                       KOHL
      K1=KX(JT,IR)                                                       KOHL
      L1=LX(JT,IR)                                                       KOHL
      IB=JF+JT                                                           KOHL
      F(IB,1)=H1**2                                                      KOHL
      F(IB,2)=K1**2                                                      KOHL
      F(IB,3)=L1**2                                                      KOHL
      F(IB,4)=H1*K1                                                      KOHL
      F(IB,5)=K1*L1                                                      KOHL
      F(IB,6)=L1*H1                                                      KOHL
160   CONTINUE                                                           KOHL
      DO 149 I=1,JF9                                                     KOHL
      IF(IRE(I)-1)142,142,145                                            KOHL
142   IRE(I)=2                                                           KOHL
      GO TO 151                                                          KOHL
145   IRE(I)=1                                                           KOHL
149   CONTINUE                                                           KOHL
151   CONTINUE                                                           KOHL
      J=9                                                                KOHL
      GO TO 61                                                           KOHL
180   CONTINUE                                                           KOHL
201   FORMAT(1X,6E16.6,E20.6)                                            KOHL
202   FORMAT(1X,3F12.5,2X,3F10.2,F13.2,F16.8,F10.1,I9)                   KOHL
  204 FORMAT(/,1H0,16H**  SOLUTION NO.,I4,4H  **)                        KOHLREF
205   FORMAT(/,1H0,7X,1HA,11X,1HB,11X,1HC,11X,5HALPHA,5X,4HBETA,6X       KOHL
     1,5HGAMMA,6X,7HVOLUME ,4X,13HSTANDARD DEV.,6X,3HM20,6X,3HN20)       KOHL
206   FORMAT(20H0NUMBER OF SOLUTIONS,I6)                                 KOHL
216   FORMAT(43H0ORDERED Q-VALUES OF THE CALCULATED LATTICE)             KOHL
217   FORMAT(1X,5(F15.6,3X,3I2,1X))                                      KOHL
221   FORMAT(1H0,7X,2HA1,14X,2HA2,14X,2HA3,14X,2HA4,14X,2HA5,14X,2HA6)   KOHL
227   FORMAT(1H0,5(9X,1HQ,9X,1HH,2H K,3H L ))                            KOHL
229   FORMAT(1X,I3,F9.3,2F11.5,2X,3I4)                                   KOHL
230   FORMAT(1H0,7X,5HD-OBS,5X,5HQ-OBS,5X,7H/QO-QC/,4X,9HH   K   L ,     KOHL-CO
     17X,8H2*THETAO,3X,11H2*(THO-THC))                                   KOHL-CO
231   FORMAT(1H+,50X,2F11.3)                                             KOHL-CO
      RETURN                                                             KOHL
      END                                                                KOHL
      FUNCTION SECOND(T)                                                 KOHL
      SECOND=0.                                                          KOHL
      RETURN                                                             KOHL
      END                                                                KOHL
      SUBROUTINE REFSET                                                  REFSR1
C---INITIALISES TEMP STORAGE FOR REFINEMENT                              REFSR1
      INTEGER H1,H2,H3,H4,HM4,H2MM,H2MI,H3MI,H4MI,H2MA,H3MA,             KOHLREF
     1HE0,HE1,HE2,HD0,HD1,HD2,H4MA,H4MAX                                 KOHLREF
     2,HRE,HSU,HSU2                                                      KOHLREF
      LOGICAL LKP,LKN,LHP,LHN,HCH,KCH                                    KOHLREF
      REAL IQW,I20                                                       KOHLREF
      DIMENSION FS1(24),FS2(24),FS3(24),FS4(24),                         KOHLREF
     1FP1(24),FP2(24),FP3(24),FP4(24),FK1(24),FK2(24),FK3(24),FK4(24),   KOHLREF
     1DF1(24),DF2(24),DF3(24),DF4(24),DFK1(24),DFK2(24),DFK3(24),        KOHLREF
     3DFK4(24),TEXT(20),FEL(50),MFH(8),MFK(8)                            KOHLREF
     4,VK(10),VG(10),FN1(24),FN2(24),FN3(24),FN4(24)                     KOHLREF
     5,IQREI(24),DFF1(24),DFF2(24),DFF3(24),DFF4(24),DLM(24),QAN(50)     KOHLREF
     6,KIZ(4,4),D(50),S(50),IK(5)                                        KOHLREF
      COMMON FEL,Q(50),NNN,LUFM,FEHLP,ITER/SCHR/TEXT,IQW,I20,MQW         KOHLREF
     1,ITEST,QN,WLENG                                                    KOHLREF
      COMMON /LSG/AZ(6,500),VVV(500)                                     KOHLREF
      COMMON /OR/IM,NQ                                                   KOHLREF
      COMMON /CQS/QS(2)                                                  KOHLREF
      COMMON /BEST/WMB                                                   KOHLREF
      COMMON /ZEIT/TILL                                                  KOHLREF
      EQUIVALENCE (D(1),VVV(1)),(VVV(51),S(1))                           KOHLREF
C---FOR USE WITH REFINE FILE FACILITY (ULCC)                             KOHLRFC
      DIMENSION TITLE(20)                                                KOHLRFC
      EQUIVALENCE (TITLE(1),TEXT(1)),(NOBS,NNN)                          KOHLRFC
      COMMON /REFCOM/ AMOLWT,DOBS,NSOL,ITEMCH,IREFCH                     KOHLRFC
      ITEMCH=38                                                           REFSR2
      IREFCH=39                                                           REFSR2
      NSOL=0                                                             REFSR2
      ALAMBD=0.                                                          KOHLREF
      IF(WLENG.GT.0.) ALAMBD=WLENG                                       KOHLREF
      AMOLWT=0.                                                          KOHLREF
      DOBS=0.                                                            KOHLREF
      REWIND ITEMCH                                                      REFSR3
      RETURN                                                             REFSR3
      END                                                                REFSR3
      SUBROUTINE REFINC(QCELL)                                           REFSR3
C---INCREMENTS NSOL AND WRITES QCELL TO FILE ITEMCH FOR TEMP STORAGE     REFSR3
C---PRIOR TO RE-READING, OUTPUT AND REFINEMENT (QCELL IS IN QU.)         REFSR3
      DIMENSION QCELL(6)                                                 REFSR3
      INTEGER H1,H2,H3,H4,HM4,H2MM,H2MI,H3MI,H4MI,H2MA,H3MA,             KOHLREF
     1HE0,HE1,HE2,HD0,HD1,HD2,H4MA,H4MAX                                 KOHLREF
     2,HRE,HSU,HSU2                                                      KOHLREF
      LOGICAL LKP,LKN,LHP,LHN,HCH,KCH                                    KOHLREF
      REAL IQW,I20                                                       KOHLREF
      DIMENSION FS1(24),FS2(24),FS3(24),FS4(24),                         KOHLREF
     1FP1(24),FP2(24),FP3(24),FP4(24),FK1(24),FK2(24),FK3(24),FK4(24),   KOHLREF
     1DF1(24),DF2(24),DF3(24),DF4(24),DFK1(24),DFK2(24),DFK3(24),        KOHLREF
     3DFK4(24),TEXT(20),FEL(50),MFH(8),MFK(8)                            KOHLREF
     4,VK(10),VG(10),FN1(24),FN2(24),FN3(24),FN4(24)                     KOHLREF
     5,IQREI(24),DFF1(24),DFF2(24),DFF3(24),DFF4(24),DLM(24),QAN(50)     KOHLREF
     6,KIZ(4,4),D(50),S(50),IK(5)                                        KOHLREF
      COMMON FEL,Q(50),NNN,LUFM,FEHLP,ITER/SCHR/TEXT,IQW,I20,MQW         KOHLREF
     1,ITEST,QN,WLENG                                                    KOHLREF
      COMMON /LSG/AZ(6,500),VVV(500)                                     KOHLREF
      COMMON /OR/IM,NQ                                                   KOHLREF
      COMMON /CQS/QS(2)                                                  KOHLREF
      COMMON /BEST/WMB                                                   KOHLREF
      COMMON /ZEIT/TILL                                                  KOHLREF
      EQUIVALENCE (D(1),VVV(1)),(VVV(51),S(1))                           KOHLREF
C---FOR USE WITH REFINE FILE FACILITY (ULCC)                             KOHLRFC
      DIMENSION TITLE(20)                                                KOHLRFC
      EQUIVALENCE (TITLE(1),TEXT(1)),(NOBS,NNN)                          KOHLRFC
      COMMON /REFCOM/ AMOLWT,DOBS,NSOL,ITEMCH,IREFCH                     KOHLRFC
      NSOL=NSOL+1                                                        REFSR3A
      WRITE(ITEMCH,1) (QCELL(I),I=1,6)                                   REFSR3A
    1 FORMAT(6F10.5)                                                     REFSR3A
      RETURN                                                             REFSR3A
      END                                                                REFSR3A
      SUBROUTINE REFSAV                                                  REFSR3A
C---CALLED WHEN SOLUTION-FINDING IS COMPLETE. ALL NSOL SOLUTIONS FOUND   REFSR3A
C---ARE READ BACK FROM TEMPORARY STORAGE CHANNEL ITEMCH AND WRITTEN TO   REFSR3A
C---CHANNEL IREFCH IN THE FORM OF CARD IMAGES THAT MAKE UP A DATA        REFSR3A
C---DECK FOR FZON(6), WITH THE NSOL SOLUTIONS AS SPECIFIED LATTICES      REFSR3A
C---TO BE NORMALISED, REFINED AND EVALUATED                              REFSR3A
      INTEGER H1,H2,H3,H4,HM4,H2MM,H2MI,H3MI,H4MI,H2MA,H3MA,             KOHLREF
     1HE0,HE1,HE2,HD0,HD1,HD2,H4MA,H4MAX                                 KOHLREF
     2,HRE,HSU,HSU2                                                      KOHLREF
      LOGICAL LKP,LKN,LHP,LHN,HCH,KCH                                    KOHLREF
      REAL IQW,I20                                                       KOHLREF
      DIMENSION FS1(24),FS2(24),FS3(24),FS4(24),                         KOHLREF
     1FP1(24),FP2(24),FP3(24),FP4(24),FK1(24),FK2(24),FK3(24),FK4(24),   KOHLREF
     1DF1(24),DF2(24),DF3(24),DF4(24),DFK1(24),DFK2(24),DFK3(24),        KOHLREF
     3DFK4(24),TEXT(20),FEL(50),MFH(8),MFK(8)                            KOHLREF
     4,VK(10),VG(10),FN1(24),FN2(24),FN3(24),FN4(24)                     KOHLREF
     5,IQREI(24),DFF1(24),DFF2(24),DFF3(24),DFF4(24),DLM(24),QAN(50)     KOHLREF
     6,KIZ(4,4),D(50),S(50),IK(5)                                        KOHLREF
      COMMON FEL,Q(50),NNN,LUFM,FEHLP,ITER/SCHR/TEXT,IQW,I20,MQW         KOHLREF
     1,ITEST,QN,WLENG                                                    KOHLREF
      COMMON /LSG/AZ(6,500),VVV(500)                                     KOHLREF
      COMMON /OR/IM,NQ                                                   KOHLREF
      COMMON /CQS/QS(2)                                                  KOHLREF
      COMMON /BEST/WMB                                                   KOHLREF
      COMMON /ZEIT/TILL                                                  KOHLREF
      EQUIVALENCE (D(1),VVV(1)),(VVV(51),S(1))                           KOHLREF
C---FOR USE WITH REFINE FILE FACILITY (ULCC)                             KOHLRFC
      DIMENSION TITLE(20)                                                KOHLRFC
      EQUIVALENCE (TITLE(1),TEXT(1)),(NOBS,NNN)                          KOHLRFC
      COMMON /REFCOM/ AMOLWT,DOBS,NSOL,ITEMCH,IREFCH                     KOHLRFC
      DIMENSION QCELL(6)                                                 REFSR4
      ENDFILE ITEMCH                                                     REFSR4
      REWIND ITEMCH                                                      REFSR4
      REWIND IREFCH                                                      REFSR4
      NR=NSOL                                                            REFSR4-
      IF(NR.GT.99) NR=99                                                 REFSR4-
      WRITE(IREFCH,100) (TITLE(I),I=1,20),ALAMBD,NR,AMOLWT,DOBS          REFSR4-
  100 FORMAT(20A4/                                                       REFSR4
     1 1H9,19X,F10.6,3X,1H1,6X,I4,3X,1H1,2X,F10.3,F10.4,10X)             REFSR4
      WRITE(IREFCH,150) (D(I),I=1,NOBS)                                  REFSR4
  150 FORMAT(F10.6,70X)                                                  REFSR4
      WRITE(IREFCH,160)                                                  REFSR4
  160 FORMAT(1H0,79X)                                                    REFSR4
      DO 200 J=1,NSOL                                                    REFSR4
      READ(ITEMCH,180) (QCELL(I),I=1,6)                                  REFSR4
      WRITE(IREFCH,180) (QCELL(I),I=1,6)                                 REFSR4
  180 FORMAT(6F10.5,20X)                                                 REFSR4
  200 CONTINUE                                                           REFSR4
      WRITE(IREFCH,250)                                                  REFSR4
  250 FORMAT(1H0,79X/3HEND,77X)                                          REFSR4-
      ENDFILE IREFCH                                                     REFSR4
      REWIND IREFCH                                                      REFSR4
      RETURN                                                             REFSR4
      END                                                                REFSR4
      SUBROUTINE EXIT                                                    KOHLREF
C---REDEFINED SO AS TO WRITE SOLUTIONS TO REFINE FILE BEFORE STOPPING    KOHLREF
      INTEGER H1,H2,H3,H4,HM4,H2MM,H2MI,H3MI,H4MI,H2MA,H3MA,             KOHLREF
     1HE0,HE1,HE2,HD0,HD1,HD2,H4MA,H4MAX                                 KOHLREF
     2,HRE,HSU,HSU2                                                      KOHLREF
      LOGICAL LKP,LKN,LHP,LHN,HCH,KCH                                    KOHLREF
      REAL IQW,I20                                                       KOHLREF
      DIMENSION FS1(24),FS2(24),FS3(24),FS4(24),                         KOHLREF
     1FP1(24),FP2(24),FP3(24),FP4(24),FK1(24),FK2(24),FK3(24),FK4(24),   KOHLREF
     1DF1(24),DF2(24),DF3(24),DF4(24),DFK1(24),DFK2(24),DFK3(24),        KOHLREF
     3DFK4(24),TEXT(20),FEL(50),MFH(8),MFK(8)                            KOHLREF
     4,VK(10),VG(10),FN1(24),FN2(24),FN3(24),FN4(24)                     KOHLREF
     5,IQREI(24),DFF1(24),DFF2(24),DFF3(24),DFF4(24),DLM(24),QAN(50)     KOHLREF
     6,KIZ(4,4),D(50),S(50),IK(5)                                        KOHLREF
      COMMON FEL,Q(50),NNN,LUFM,FEHLP,ITER/SCHR/TEXT,IQW,I20,MQW         KOHLREF
     1,ITEST,QN,WLENG                                                    KOHLREF
      COMMON /LSG/AZ(6,500),VVV(500)                                     KOHLREF
      COMMON /OR/IM,NQ                                                   KOHLREF
      COMMON /CQS/QS(2)                                                  KOHLREF
      COMMON /BEST/WMB                                                   KOHLREF
      COMMON /ZEIT/TILL                                                  KOHLREF
      EQUIVALENCE (D(1),VVV(1)),(VVV(51),S(1))                           KOHLREF
C---FOR USE WITH REFINE FILE FACILITY (ULCC)                             KOHLRFC
      DIMENSION TITLE(20)                                                KOHLRFC
      EQUIVALENCE (TITLE(1),TEXT(1)),(NOBS,NNN)                          KOHLRFC
      COMMON /REFCOM/ AMOLWT,DOBS,NSOL,ITEMCH,IREFCH                     KOHLRFC
      DO 10 I=1,NOBS                                                     KOHLREF
   10 D(I)=1./SQRT(Q(I))                                                 KOHLREF
C---D(I) WILL NOW BE SORTED, AS KOHL HAS BEEN FOUND TO CHANGE THE        KOHLREF
C---SEQUENCE OF LINES IN Q(I) FROM THAT IN D(I) AT INPUT                 KOHLREF
      NSORT=NOBS-1                                                       KOHLREF
   20 ISORT=0                                                            KOHLREF
      DO 30 I=1,NSORT                                                    KOHLREF
      J=I+1                                                              KOHLREF
      IF(D(J).LT.D(I)) GOTO 30                                           KOHLREF
      TEMP=D(I)                                                          KOHLREF
      D(I)=D(J)                                                          KOHLREF
      D(J)=TEMP                                                          KOHLREF
      ISORT=1                                                            KOHLREF
   30 CONTINUE                                                           KOHLREF
      IF(ISORT.EQ.1) GOTO 20                                             KOHLREF
C---COPY SAVED SOLUTIONS TO REFINE FILE (ULCC)                           REFSAVE
      CALL REFSAV                                                        REFSAVE
C---READ SOLUTIONS, ETC. FROM REFINE FILE AND USE MODIFIED VERSION       FZRFCOM
C--- OF DUTCH ZONE-INDEXING PROGRAM FOR NORMALISATION, REFINEMENT        FZRFCOM
C--- AND EVALUATION (ULCC)                                               FZRFCOM
      CALL FZONRF                                                        FZRFCOM
      STOP                                                               KOHLREF
      RETURN                                                             KOHLREF
      END                                                                KOHLREF
      SUBROUTINE FZONRF                                                  FZRF
C  --------------------------------------------------------------------- FZRF
C---THIS IS A CUT-DOWN VERSION OF JAN VISSER'S ZONE-INDEXING PROGRAM,    FZRF
C--- DESIGNED TO BE CALLED AS A SUBROUTINE FOR NORMALISING, REFINING,    FZRF
C--- EVALUATING AND DISPLAYING SPECIFIED SOLUTIONS. IT EXPECTS DATA      FZRF
C--- IN THE FORM OF A DECK OF CARD IMAGES IN THE =REFINE= FILE           FZRF
C--- (CHANNEL 9). AS THIS CAN ALSO BE PRINTED TO GIVE A LISTING OF THE   FZRF
C--- INPUT DATA, SUBROUTINE ECHO HAS BEEN MADE A DUMMY IN THIS VERSION.  FZRF
C-- *** BASED ON VERSION 6                                               FZRF
C-- *** INCLUDING UNIVERSITY OF SURREY MODS UP TO FZON6-7A AND 8         FZRF
C-- *** DATED OCTOBER 1977                                               FZRF
C-- *** ROBIN SHIRLEY, CHEMICAL PHYSICS DEPARTMENT                       FZRF
C  --------------------------------------------------------------------- FZRF
C                                                                        FZRF
C             THIS PROGRAM WAS WRITTEN BY                                FZRF
C                        J.W. VISSER                                     FZRF
C             OF THE TECHNISCH PHYSISCHE DIENST TNO-TH                   FZRF
C             P.O.BOX 155 DELFT NETHERLANDS.                             FZRF
C              IT CONTAINS MANY IDEAS AND SUGGESTIONS FROM               FZRF
C                       PROF.DR. P.M. DE WOLFF                           FZRF
C             OF THE TECHNICAL UNIVERSITY (T.H) DELFT.                   FZRF
C                                                                        FZRF
C                                                                        FZRF
C             A DESCRIPTION OF THE PROGRAM WAS PUBLISHED IN              FZRF
C             JOURNAL OF APPLIED CRYSTALLOGRAPHY.(1969) 2,89.            FZRF
C                                                                        FZRF
C                                                                        FZRF
C             THIS WORK WAS LARGELY SPONSORED BY THE                     FZRF
C             JOINT COMMITTEE ON POWDER  DIFFRACTION STANDARDS           FZRF
C             NOW AT  1601 PARK LANE, SWARTHMORE, PA. 19081              FZRF
C             AND THE CENTRAL ORGANIZATION FOR  TNO, THE HAGUE,          FZRF
C             NETHERLANDS.                                               FZRF
C                                                                        FZRF
C                                                                        FZRF
C----------------------------------------------------------------------- FZRF
C     THE INPUT OF THIS PROGRAM SHOULD CONSIST OF0                       FZRF
C     1. A TITLE CARD,CONTAINING UP TO 80 CHARACTERS                     FZRF
C     2. A PARAMETER CARD,WHICH MAY BE  COMPLETELY BLANK.                FZRF
C     3. A NUMBER OF LINES CARDS, CONTAINING THE POSITIONS OF THE LINES  FZRF
C        THESE CAN BE ENTERED AS D-,Q- OR TWOTHETA VALUES. ( 8 F10.5 )   FZRF
C        YOU MAY LEAVE ANY NUMBER OF POSITIONS PER CARD  BLANK.          FZRF
C        THIS MEANS THAT YOU CAN ALSO ENTER ONLY ONE LINE PER CARD,      FZRF
C        IN ANY ONE OF THE POSITIONS OF 8F10.5                           FZRF
C     4. A BLANK CARD, TO FINISH THE INPUT OF ONE PROBLEM.               FZRF
C                                                                        FZRF
C        REPEAT THE ABOVE  AS MANY TIMES AS PROBLEMS,   -- THEN --       FZRF
C     5. A CARD CONTAINING THE WORD  --  END  -- IN THE FOUR FIRST COLUM FZRF
C        EITHER RIGHT- OR LEFT ADJUSTED,  TO FINISH THE INPUT.           FZRF
C                                                                        FZRF
C  THE PROGRAM WILL TAKE ITS OWN (DEFAULT) PARAMETERS.                   FZRF
C  FOR THE INITIATED THE SUBROUTINE READER GIVES FULL DETAILS ABOUT      FZRF
C  ALL THE  POSIBILITIES OF THE PROGRAM.                                 FZRF
C                                                                        FZRF
C  THE INPUT OF THE PROGRAM IS ON UNIT 5,                                FZRF
C  THE OUTPUT IS ON UNIT  6.                                             FZRF
C  ON UNIT 4 YOU MAY GET TEST OUTPUT, THESE ARE THE CARD IMAGES          FZRF
C  OF THE INPUT CARDS.                                                   FZRF
C                                                                        FZRF
C                                                                        FZRF
C----------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
C                                                                        FZRF
C                         GENERAL FLOW OF SUBROUTINES                    FZRF
C                                                                        FZRF
C----------------------------------------------------------------------- FZRF
C                                                                        FZRF
C                                                                        FZRF
C        *******            *******           **********                 FZRF
C        *     *            *     * <-------> *  ECHO  *                 FZRF
C        *     *            *  R  *           **********                 FZRF
C        *     *            *     *                                      FZRF
C        *     * <--------> *  E  *           **********                 FZRF
C        *     *            *     * <-------> * MANUAL *                 FZRF
C        *     *            *  A  *           **********                 FZRF
C        *     *            *     *                                      FZRF
C        *     *            *  D  *           **********                 FZRF
C        *     *            *     * <-------> * INSTRS *                 FZRF
C        *     *            *  E  *           **********                 FZRF
C        *     *            *     *                                      FZRF
C        *     *            *  R  *           **********                 FZRF
C        *     *            *     * <-------> * SRTRON *                 FZRF
C        *     *            *******           **********                 FZRF
C        *     *                                                         FZRF
C        *  M  *            *********                                    FZRF
C        *     *  <-------> * NORM3 *                                    FZRF
C        *     *            *********                                    FZRF
C        *     *                                                         FZRF
C        *     *            *******           **********                 FZRF
C        *  A  *            *     *  <------> * WISSEL *                 FZRF
C        *     *            *  R  *           **********                 FZRF
C        *     *            *     *           *********                  FZRF
C        *     *            *  E  *  <------> * WRISP *                  FZRF
C        *     *            *     *           *********                  FZRF
C        *     *  <-------> *  F  *           *********                  FZRF
C        *     *            *     *  <------> * ARRAY *                  FZRF
C        *  I  *            *  P  *           *********                  FZRF
C        *     *            *     *           ********                   FZRF
C        *     *            *  A  *  <------> * MINV *                   FZRF
C        *     *            *     *           ********                   FZRF
C        *     *            *  R  *           *********                  FZRF
C        *     *            *     *  <------> * NORM3 *                  FZRF
C        *     *            *     *           *********                  FZRF
C        *     *            *     *           **********                 FZRF
C        *     *            *     *  <------> * LISTM  *                 FZRF
C        *     *            *******           **********                 FZRF
C        *     *                                                         FZRF
C        *     *                                                         FZRF
C        *     *            **********                                   FZRF
C        *  N  *  <-------> * UNTCEL *                                   FZRF
C        *     *            **********                                   FZRF
C        *     *                                                         FZRF
C        *     *                                                         FZRF
C        *     *            **********                                   FZRF
C        *     *  <-------> * SYMTST *                                   FZRF
C        *     *            **********                                   FZRF
C        *     *                                                         FZRF
C        *     *                                                         FZRF
C        *******                                                         FZRF
C                                                                        FZRF
C----------------------------------------------------------------------- FZRF
C                                                                        FZRF
      DIMENSION STORE(200,6 ),BRAVTP(6),ISYST(3,3)                       FZRF
      INTEGER  H,H1                                                      FZRF
C----------------------------------------------------------------------- FZRF
C                                                                        FZRF
C        ****************************                                    FZRF
C        * ATTENTION   H = INTEGER  *                                    FZRF
C        ****************************                                    FZRF
C                                                                        FZRF
C----------------------------------------------------------------------- FZRF
      LOGICAL SELF,ENL,TEST,LIST                                         FZRF
      LOGICAL RECTAN                                                     FZRF
CDC---LEVEL STATEMENTS FOR CDC 7600 FOLLOW---REMOVE FOR OTHER MACHINES-- LEV2
CDC   LEVEL 2, LINCO,NQ2,NSOLMX,ROSTER                                   FZRFL2
C---COMMON BLOCK /TEMRES/, LENGTH 11613 (OCTAL), 5003 (DECIMAL)          FZRFL2
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
      COMMON /PARMS / TOL2,TOL3,WAVEL,FMINEQ,FMINIM,SELF,ENL,TEST,LIST,  FZRF
     *                NSYST(3),OBSMT(40),OBSPT(40)                       FZRF
      COMMON /TEMRES/ LINCO,NQ2,NSOLMX,ROSTER(500,10)                    FZONRFM
      COMMON /REFP/ IREF                                                 FZRF
      DATA  BRAVTP/1HA,1HB,1HC,1HI,1HF,1HP/                              FZRF
      DATA ISYST(1,1)/4HORTH/,ISYST(1,2)/4HORHO/,ISYST(1,3)/4HMBIC/,     FZRF
     1     ISYST(2,1)/4HMONO/,ISYST(2,2)/4HCLIN/,ISYST(2,3)/4HIC  /,     FZRF
     2     ISYST(3,1)/4HTRIC/,ISYST(3,2)/4HLINI/,ISYST(3,3)/4HIC   /     FZRF
C                                                                        FZRF
      JOB=0                                                              FZRF
    1 RAD=57.29578                                                       FZRF
      INP=39                                                             FZRF
C---INPUT WILL BE TAKEN FROM THE =REFINE= FILE                           FZRF
      IOUT=6                                                             FZRF
      NRMAX=200                                                          FZRF
      NSOLMX=500                                                         FZRF
      NREFMX=10                                                          FZRF
      NORDER=4                                                           FZRF
      DO 10 I=1,100                                                      FZRF
      DO 5 J=1,10                                                        FZRF
   5  ROSTER(I,J)=0.0                                                    FZRF
  10  CONTINUE                                                           FZRF
      DO 30 I=1,200                                                      FZRF
      DO 20 J=1,6                                                        FZRF
   20 STORE(I,J)=0.0                                                     FZRF
  30  CONTINUE                                                           FZRF
C                                                                        FZRF
      CALL       READER(NZ1,NZ2,NR,WMOL,DOBS)                            FZRF
      IF (NR .EQ. -1) GOTO 8000                                          FZRF
C                                                                        FZRF
      N4=NR                                                              FZRF
      NR=0                                                               FZRF
C  --------------------------------------------------------------------- FZRF
C--THE LATTICES FOUND WILL BE PUT INTO A STANDARD SHAPE.(NORMALISED)     FZRF
C  --------------------------------------------------------------------- FZRF
      IF (ENL) WRITE (IOUT,9936)                                         FZRF
      DO  1990 J=1,N4                                                    FZRF
      IF (ROSTER(J,7) .LT. 1.0) GO TO  1990                              FZRF
      DO 1950  I=1,6                                                     FZRF
 1950 CEL(I)=ROSTER(J,I)                                                 FZRF
      CALL NORM3                                                         FZRF
      DO 1955 I=1,6                                                      FZRF
 1955 ROSTER(J,I)=CEL(I)                                                 FZRF
      DO 1960 K=1,3                                                      FZRF
      IF (ROSTER(J,K) .LT. FMINIM) GO TO 1990                            FZRF
 1960 CONTINUE                                                           FZRF
      NR=NR+1                                                            FZRF
      DO 1965 K=1,8                                                      FZRF
 1965 ROSTER(NR,K)=ROSTER(J,K)                                           FZRF
      IF(ENL) WRITE(IOUT,9937) NR,(ROSTER(NR,K),K=1,8)                   FZRF
 1990 CONTINUE                                                           FZRF
C----------------------------------------------------------------------- FZRF
C  THE LATTICES ARE NOW NORMALIZED,AND THE PATHOLOGICAL CASES HAVE       FZRF
C  BEEN DROPPED. THE NEXT STEP IS TO TRY AND REFINE THE LATTICES THAT    FZRF
C  ARE LEFT.                                                             FZRF
C  --------------------------------------------------------------------- FZRF
C  --------------------------------------------------------------------- FZRF
C  FIRST WE ELIMINATE 'EQUAL' LATTICES .                                 FZRF
      NR1=NR-1                                                           FZRF
      DO 2050 H=1,NR1                                                    FZRF
      H1=H+1                                                             FZRF
      DO 2040 K=H1,NR                                                    FZRF
      U=0.0                                                              FZRF
      DO 2030 L=1,6                                                      FZRF
 2030 U=U+ABS( ROSTER(H,L)- ROSTER(K,L))                                 FZRF
      IF (U.GT. FMINEQ) GO TO 2040                                       FZRF
      IF ( ROSTER(H,7).GE.  ROSTER(K,7)) GO TO 2035                      FZRF
       ROSTER(H,7)=0.0                                                   FZRF
      GO TO 2040                                                         FZRF
 2035  ROSTER(K,7)=0.0                                                   FZRF
 2040 CONTINUE                                                           FZRF
 2050 CONTINUE                                                           FZRF
C----------------------------------------------------------------------- FZRF
C  A FIRST ROUND OF LEAST SQUARES (IN REFPAR) WILL NOW BE RUN.           FZRF
C  --------------------------------------------------------------------- FZRF
 2055 NSOL=0                                                             FZRF
      NREFCY=3                                                           FZRF
      DO 2100 I=1,NR                                                     FZRF
      IF ( ROSTER(I,7) .LT. 1.0) GO TO 2100                              FZRF
      DO 2060 K=1,10                                                     FZRF
 2060 CEL(K)= ROSTER(I,K)                                                FZRF
      CEL(7)=0.0                                                         FZRF
      CEL(10)=CEL(8)                                                     FZRF
      NSOL=NSOL+1                                                        FZRF
      DO 2065 IREF=1,NREFCY                                              FZRF
      CALL REFPAR(NSOL)                                                  FZRF
 2065 CONTINUE                                                           FZRF
      IREF=0                                                             FZRF
      DO 2070 K=1,10                                                     FZRF
 2070 ROSTER(NSOL,K)=CEL(K)                                              FZRF
 2100 CONTINUE                                                           FZRF
      NR=NSOL                                                            FZRF
C  --------------------------------------------------------------------- FZRF
C--A DOUBLE SORT WILL NOW BE CARRIED OUT, FIRST ON THE NUMBER OF         FZRF
C  LINES INDEXED(POS. 7)   AND SECONDLY ON THE FIGURE OF MERIT (POS. 8)  FZRF
C--OF THE LATTICES.                                                      FZRF
C  --------------------------------------------------------------------- FZRF
      WRITE(IOUT,9950) NAME                                              FZRF
      WRITE(IOUT,9951)                                                   FZRF
      JJ=100                                                             FZRF
      DO 3050 L=1,NR                                                     FZRF
      K=0                                                                FZRF
      AA=0.                                                              FZRF
      DO 3040 H=L,NR                                                     FZRF
      M= ROSTER(H,7)+0.5                                                 FZRF
      B= ROSTER(H,8)                                                     FZRF
      IF (M-K) 3040,3020,3010                                            FZRF
 3010 K=M                                                                FZRF
      I=H                                                                FZRF
      AA=B                                                               FZRF
      GO TO 3040                                                         FZRF
 3020 IF(B.LE.AA) GO TO 3040                                             FZRF
      AA=B                                                               FZRF
      I=H                                                                FZRF
 3040 CONTINUE                                                           FZRF
      IF (K.GE.JJ) GO TO 3045                                            FZRF
      WRITE(IOUT,9952)                                                   FZRF
      JJ=K                                                               FZRF
 3045 DO 3048 N=1,10                                                     FZRF
      A= ROSTER(I,N)                                                     FZRF
       ROSTER(I,N)= ROSTER(L,N)                                          FZRF
       ROSTER(L,N)=A                                                     FZRF
      CEL(N)=ROSTER(L,N)                                                 FZRF
 3048 CONTINUE                                                           FZRF
      CALL UNTCEL(WMOL,DOBS,VOL,0)                                       FZRF
      KKK=INT(ROSTER(L,9)+0.5)                                           FZRF
      WRITE(IOUT,9953) (ROSTER(L,N),N=1,8),BRAVTP(KKK),                  FZRF
     * ROSTER(L,10), VOL                                                 FZRF
 3050 CONTINUE                                                           FZRF
C----------------------------------------------------------------------- FZRF
C--END OF SORT AND PRINT.                                                FZRF
C----------------------------------------------------------------------- FZRF
      WRITE(IOUT,9963)                                                   FZRF
C----------------------------------------------------------------------- FZRF
C--WE NOW PRINT OUT THE BEST FOUR SOLUTIONS WITH AN INDEXED LIST         FZRF
C  OF THE FIRST TWENTY LINES.  IF YOU HAVE SET  'ENL' THEN YOU ALSO      FZRF
C--GET  THE Q-VALUES PRINTED OUT AS A  LATTICE.                          FZRF
C----------------------------------------------------------------------- FZRF
      WRITE(IOUT,9964) NREFMX                                            FZRF
      N=0                                                                FZRF
      SELF=.TRUE.                                                        FZRF
      DO 3052 I=1,3                                                      FZRF
 3052 IF (NSYST(I) .EQ.1) N=I                                            FZRF
      IF (N .NE. 0) SELF=.FALSE.                                         FZRF
      IF (SELF) GO TO 3058                                               FZRF
      MIN=-1                                                             FZRF
      N=0                                                                FZRF
      M=0                                                                FZRF
      DO 3054 K=1,3                                                      FZRF
      IF (NSYST(K) .EQ. 1) WRITE(IOUT,9965) (ISYST(K,I),I=1,3)           FZRF
      IF (NSYST(K) .EQ. 1) N=N+1                                         FZRF
      IF (NSYST(K) .EQ.(-1)) WRITE(IOUT,9966) (ISYST(K,I),I=1,3)         FZRF
      IF (NSYST(K) .EQ.(-1) ) M=M+1                                      FZRF
 3054 CONTINUE                                                           FZRF
      IF (N .GT. 0) MIN=1                                                FZRF
      IF (M .GT. 0) MIN=0                                                FZRF
      DO 3056 M=1,MAX                                                    FZRF
      DIF=OBS(M)-OBSMT(M)                                                FZRF
      OBSMT(M)=OBSMT(M)-DIF                                              FZRF
 3056 OBSPT(M)=OBSPT(M)+DIF                                              FZRF
C  THE TOLERANCES HAVE BEEN DOUBLED WHEN YOU WANT TO  FORCE A CERTAIN    FZRF
C  CRYSTAL SYSTEM.                                                       FZRF
 3058 NSOL=0                                                             FZRF
      DO 3100 I=1,NR                                                     FZRF
      IF(NSOL.EQ.NREFMX) GOTO 3105                                       FZRF
      IF (SELF) GO TO 3090                                               FZRF
      NORDE=1                                                            FZRF
      DO 3080 J=4,6                                                      FZRF
 3080 IF (ABS(ROSTER(I,J)) .GT. FMINEQ) NORDE=NORDE+1                    FZRF
      IF (NORDE .EQ. 4) NORDE=3                                          FZRF
      IF (NSYST(NORDE) .LT. MIN) GO TO 3100                              FZRF
 3090 NSOL=NSOL+1                                                        FZRF
      DO 3060 J=1,10                                                     FZRF
 3060 CEL(J)= ROSTER(I,J)                                                FZRF
      CALL REFPAR(NSOL)                                                  FZRF
      DO 3070 J=1,10                                                     FZRF
 3070  ROSTER(I,J)=CEL(J)                                                FZRF
 3100 CONTINUE                                                           FZRF
C  AFTER THIS REFINEMENT CYCLE, A NEW DOUBLE SORT IS MADE                FZRF
 3105 NSOL=NREFMX                                                        FZRF
      IF(NR.LT.NREFMX) NSOL=NR                                           FZRF
      DO 3250 L=1,NSOL                                                   FZRF
      K=0                                                                FZRF
      AA=0.                                                              FZRF
      DO 3240 H=L,NR                                                     FZRF
      M=ROSTER(H,7)+0.5                                                  FZRF
      B=ROSTER(H,8)                                                      FZRF
      IF (M-K) 3240,3220,3210                                            FZRF
 3210 K=M                                                                FZRF
      I=H                                                                FZRF
      AA=B                                                               FZRF
      GO TO 3240                                                         FZRF
 3220 IF(B.LE.AA) GO TO 3240                                             FZRF
      AA=B                                                               FZRF
      I=H                                                                FZRF
 3240 CONTINUE                                                           FZRF
      DO 3248 N=1,10                                                     FZRF
      A=ROSTER(I,N)                                                      FZRF
      ROSTER(I,N)=ROSTER(L,N)                                            FZRF
      ROSTER(L,N)=A                                                      FZRF
 3248 CONTINUE                                                           FZRF
 3250 CONTINUE                                                           FZRF
      WRITE(IOUT,9954) NAME,NREFMX                                       FZRF
      DO 3110 I=1,NSOL                                                   FZRF
      KKK=INT(ROSTER(I,9)+0.5)                                           FZRF
 3110 WRITE(IOUT,9955) ( ROSTER(I,N),N=1,8),  ROSTER(I,10),BRAVTP(KKK)   FZRF
      WRITE(IOUT,9956)                                                   FZRF
      DO 3120 I=1,NSOL                                                   FZRF
      DO 3115 J=1,10                                                     FZRF
 3115 CEL(J)= ROSTER(I,J)                                                FZRF
      CALL UNTCEL(WMOL,DOBS,VOL,1)                                       FZRF
 3120 CONTINUE                                                           FZRF
C----------------------------------------------------------------------- FZRF
C--PRINTS THE VALUES OF THE PARAMETERS OF THE DIRECT LATTICE.            FZRF
C----------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
      DO 3150  I=1,NSOL                                                  FZRF
      DO 3140 J=1,10                                                     FZRF
 3140 CEL(J)=ROSTER(I,J)                                                 FZRF
      CALL SYMTST                                                        FZRF
 3150 CONTINUE                                                           FZRF
C----------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
C  THE BEST SOLUTIONS ARE TESTED ON HIGHER SYMMETRIES,THAT MAY BE        FZRF
C  CONCEALED IN THE Q-VALUES.                                            FZRF
C----------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
      WRITE(IOUT,9957)                                                   FZRF
      WRITE(IOUT,9959)                                                   FZRF
      WRITE(IOUT,9958) NAME                                              FZRF
C  --------------------------------------------------------------------- FZRF
      GO TO 1                                                            FZRF
C----------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
C--- FINAL RETURN                                                        FZRF
 8000 CONTINUE                                                           FZRF
      RETURN                                                             FZRF
C----------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
 9936 FORMAT(                                                            FZRF
     160H1        LATTICES REDUCED AND PUT INTO STANDARD FORM        //  FZRF
     260H SERIAL   A       B       C        D       E       F       H,   FZRF
     320HITS   PEDIGREE        )                                         FZRF
 9937 FORMAT(1H ,I5,6F8.1, 2F8.0)                                        FZRF
 9950 FORMAT(1H1,20A4)                                                   FZRF
 9951 FORMAT(1H0,14X,47HTRIAL LATTICES AFTER INDEXING AND LS REFINEMENT  FZRF
     *//14X,52HONLY THE FIRST 20 LINES ARE CONSIDERED FOR INDEXING  //   FZRF
     *59X,24HLINES  FIGURE    BRAVAIS/                                   FZRF
     *95H      A        B        C        D         E        F    INDEXE FZRF
     *D  OF MERIT  LATTICE  PEDIGREE   ,6HVOLUME )                       FZRF
 9952 FORMAT(1H )                                                        FZRF
 9953 FORMAT(1H ,6F9.1,F9.0,F9.1,8X,A1,F9.0,F8.1 )                       FZRF
 9954 FORMAT(1H1,20A4 /// 30X,                                           FZRF
     1 4HTHE ,I2,24H MOST PROBABLE SOLUTIONS//// 58X,                    FZRF
     234HLINES  FIGURE OF           BRAVAIS/                             FZRF
     360H    Q(A)     Q(B)     Q(C)      Q(D)     Q(E)     Q(F)   IND,   FZRF
     433HEXED   MERIT   PEDIGREE  LATTICE        )                       FZRF
 9955 FORMAT(1H ,6F9.2,F9.0,F9.1,F9.0,8X,A1)                             FZRF
 9956 FORMAT(1H0,20X,38HTHE DIRECT CONSTANTS OF THESE LATTICES//         FZRF
     *60H     A        B        C       ALFA     BETA     GAMMA      ,   FZRF
     * 6HVOLUME)                                                         FZRF
 9957 FORMAT(1H0///40X,24H ****   ATTENTION   ****//                     FZRF
     160H 1. ANY 'SOLUTION' WITH A FIGURE OF MERIT LESS THAN 4.0 IS W,   FZRF
     260HORTHLESS AND SHOULD BE REJECTED RIGHT AWAY.                 //  FZRF
     360H 2. ANY 'SOLUTION'THAT LEAVES MORE THAN TWO VERY WEAK LINES ,   FZRF
     460HUNEXPLAINED  IS WORTHLESS.   HOWEVER, IF THE FIGURE OF MERIT/   FZRF
     560H    IS GREATER THAN 10.0 IT MIGHT BE WORTHWHILE TO EXAMINE  ,   FZRF
     660HTHE INPUT DATA  AND THE 'SOLUTION' MORE CLOSELY.            //  FZRF
     760H 3. EVEN 'SOLUTIONS' THAT INDEX ALL LINES WITH A FIGURE OF M,   FZRF
     860HERIT GREATER THAN 10.0 SHOULD NOT BE ACCEPTED UNCRITICALLY  /   FZRF
     933H    WITHOUT FURTHER INVESTIGATION//)                            FZRF
 9958 FORMAT(1H0,20A4)                                                   FZRF
 9959 FORMAT(71H0******************************************************* FZRF
     1***************/2H *,68X,1H*/2H *,  69H  THIS PROGRAM GIVES A NUMB FZRF
     2ER OF SUGGESTIONS THAT MAY HELP YOU TO   */ 71H *  FIND THE UNIT C FZRF
     3ELL THAT EXPLAINS YOUR EXPERIMENTAL DATA. HOWEVER  */2H *,68X,     FZRF
     4 1H*/ 2H *,5X,58HWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW FZRF
     4WWWWWWWWW,         6H     */8H *     W,56X,7HW     */ 8H *     W,  FZRF
     5 63H   IT IS ENTIRELY THE USERS RESPONSIBILITY TO DECIDE    W      FZRF
     6* /71H *     W   WHETHER ANY OF THE SUGGESTED UNIT CELLS IS THE    FZRF
     7    W     *  / 71H *     W   CORRECT CELL.                         FZRF
     8                W     * / 8H *     W, 56X, 7HW     * / 7H *      , FZRF
     9 58(1HW), 6H     * / 2H *,68X,1H*/1H ,70(1H*) )                    FZRF
 9963 FORMAT(7H0NOTES0//                                                 FZRF
     160H  1. 'LINES INDEXED' REFERS TO THE NUMBER OF LINES FROM THE ,   FZRF
     260HFIRST 20 OBSERVED LINES THAT HAVE BEEN ACCEPTED AS INDEXED  /   FZRF
     360H     BY THIS LATTICE, UP TO A MAXIMUM OF 20, WHICH WOULD REP,   FZRF
     460HRESENT COMPLETE SUCCESS.                                    //  FZRF
     560H  2. 'FIGURE OF MERIT' IS DEFINED AS QOBS(20)/(2*MEANDIFF*NC,   FZRF
     660HALC) WHERE DIFFERENCES ARE TAKEN FOR INDEXED LINES ONLY     /   FZRF
     760H     AND 'NCALC' IS THE NUMBER OF LINES GENERATED UP TO Q=1.,   FZRF
     860H003*Q(20),REGARDLESS OF WHETHER OR NOT THEY CONTRIBUTE TO   /   FZRF
     960H     THE INDEXINGS, BUT EXCLUDING SYSTEMATIC ABSENCES DUE TO,   FZRF
     *27H THE BRAVAIS LATTICE TYPE. /                                    FZRF
     A60H     IT IS CLOSELY RELATED TO  M20 ,DE WOLFF(J.APPL.CRYST.19,   FZRF
     B60H68,1972), ALLOWING FOR LESS THAN 20 SUCCESSFUL INDEXINGS.   )   FZRF
 9964 FORMAT(5H0THE ,I2,49H BEST SOLUTIONS ARE NOW PRINTED MORE EXTENSIV FZRF
     1ELY.)                                                              FZRF
 9965 FORMAT( 1H0,3A4, 23H LATTICES ARE PRINTED.  )                      FZRF
 9966 FORMAT( 1H0,3A4,27H LATTICES ARE NOT PRINTED.  )                   FZRF
      END                                                                FZRF
      SUBROUTINE ARRAY(MODE,I,J,N,M,S,D)                                 FZRF
C                                                                        FZRF
C  COPIED FROM  THE I.B.M.  SCIENTIFIC SUBROUTINE PACKAGE.               FZRF
C  TO BE USED IN COMBINATION WITH THE SUBROUTINE  MINV (MATRIX INVERSION FZRF
C                                                                        FZRF
      DIMENSION S(36),D(36)                                              FZRF
      NI=N-I                                                             FZRF
      IF(MODE .GT. 1) GO TO 20                                           FZRF
      IJ=I*J+1                                                           FZRF
      NM=N*J+1                                                           FZRF
      DO 10 K=1,J                                                        FZRF
      NM=NM-NI                                                           FZRF
      DO 10 L=1,I                                                        FZRF
      IJ=IJ-1                                                            FZRF
      NM=NM-1                                                            FZRF
      D(NM)=S(IJ)                                                        FZRF
   10 CONTINUE                                                           FZRF
      GO TO 40                                                           FZRF
   20 IJ=0                                                               FZRF
      NM=0                                                               FZRF
      DO 30 K=1,J                                                        FZRF
      DO 25 L=1,I                                                        FZRF
      IJ=IJ+1                                                            FZRF
      NM=NM+1                                                            FZRF
      S(IJ)=D(NM)                                                        FZRF
   25 CONTINUE                                                           FZRF
      NM=NM+NI                                                           FZRF
   30 CONTINUE                                                           FZRF
   40 RETURN                                                             FZRF
      END                                                                FZRF
      SUBROUTINE ECHO                                                    FZRF
C----------------------------------------------------------------------- FZRF
C  THE PURPOSE OF THIS SUBROUTINE IS TO PRINT THE CARD IMAGES OF THE INP FZRF
C     CARDS ON A SEPARATE PAGE                                           FZRF
C  THIS IS VERY USEFUL FOR TEST PURPOSES AND FOR DOCUMENTATION.          FZRF
C                                                                        FZRF
C  ON SOME MACHINES IT IS NOT POSSIBLE AT ALL TO  BACKSPACE  THE         FZRF
C  INPUT FILE.  IN THIS CASE YOU COULD READ THE INPUT DATA FROM          FZRF
C  THE INPUT FILE(IN ECHO), WRITE THEM AGAIN ON A TEMPORARY FILE         FZRF
C  AND READ THEM FROM THIS TEMPORARY FILE IN SUBROUTINE  READER.         FZRF
C  SINCE THIS IS RATHER  'MACHINE-DEPENDENT', I LEAVE IT TO YOUR         FZRF
C  OWN IMAGINATION AND INGENUITY..............                           FZRF
C----------------------------------------------------------------------- FZRF
C  YOU CAN ALSO GET RID OF THE WHOLE  PROBLEM BY REPLACING THE           FZRF
C  SUBROUTINE BY A  DUMMY SUBROUTINE, AS FOLLOWS                         FZRF
C                                                                        FZRF
C     SUBROUTINE  ECHO                                                   FZRF
C     RETURN                                                             FZRF
C     END                                                                FZRF
C                                                                        FZRF
C----------------------------------------------------------------------- FZRF
      RETURN                                                             FZRF
      END                                                                FZRF
      SUBROUTINE  LISTM(NCALC)                                           FZRF
      DIMENSION INSTOR(100,3),QSTOR(100)                                 FZRF
      LOGICAL SELF,ENL,TEST,LIST                                         FZRF
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
      COMMON /PARMS / TOL2,TOL3,WAVEL,FMINEQ,FMINIM,SELF,ENL,TEST,LIST,  FZRF
     *                NSYST(3),OBSMT(40),OBSPT(40)                       FZRF
      COMMON /LINSTR/ INSTOR,QSTOR                                       FZRF
      SWAVEL=WAVEL/200.                                                  FZRF
      NOLIM=20                                                           FZRF
      IF(MAX.LE.20) NOLIM=MAX-1                                          FZRF
C--SORT CALCULATED VALUES.                                               FZRF
      DO 100 I=1,NCALC                                                   FZRF
      Q=1.E+6                                                            FZRF
      DO  60 J=I,NCALC                                                   FZRF
      IF (QSTOR(J).GT. Q) GO TO 60                                       FZRF
      Q=QSTOR(J)                                                         FZRF
      N=J                                                                FZRF
   60 CONTINUE                                                           FZRF
      U=QSTOR(I)                                                         FZRF
      QSTOR(I)=QSTOR(N)                                                  FZRF
      QSTOR(N)=U                                                         FZRF
      DO  80 K=1,3                                                       FZRF
      INX  =INSTOR(I,K)                                                  FZRF
      INSTOR(I,K)=INSTOR(N,K)                                            FZRF
   80 INSTOR(N,K)= INX                                                   FZRF
  100 CONTINUE                                                           FZRF
      NO=1                                                               FZRF
      NC=1                                                               FZRF
      UL=0.                                                              FZRF
      NWR=21                                                             FZRF
      IF(MAX.LT.21) NWR=MAX                                              FZRF
      WRITE(IOUT,9903) NWR                                               FZRF
      WRITE(IOUT,9904)                                                   FZRF
C--PRINT QCALC AND QOBS IN ORDER OF TWOTHETA.                            FZRF
  110 CONTINUE                                                           FZRF
      IF (NC .GT. NCALC) GO TO 200                                       FZRF
      IF (NO .GT. NWR) GO TO 115                                         FZRF
      IF (QSTOR(NC) .GT. OBS(NO)) GO TO 200                              FZRF
  115 CONTINUE                                                           FZRF
      W=SQRT(QSTOR(NC))                                                  FZRF
      U=SWAVEL*W                                                         FZRF
      W=100./W                                                           FZRF
      U=114.59156*ATAN(U/SQRT(1.0-U*U))                                  FZRF
      IF (U-UL .GT. 0.05) WRITE(IOUT,9905)                               FZRF
      WRITE(IOUT,9901) U,W,(INSTOR(NC,K),K=1,3),QSTOR(NC)                FZRF
      UL=U                                                               FZRF
      NC=NC+1                                                            FZRF
      IF (NC .LE. NCALC ) GO TO 110                                      FZRF
      IF (NO .GE. NWR) GO TO 300                                         FZRF
  200 W=SQRT(OBS(NO))                                                    FZRF
      U=SWAVEL*W                                                         FZRF
      W=100./W                                                           FZRF
      U=114.59156*ATAN(U/SQRT(1.0-U*U))                                  FZRF
      IF (U-UL .GT. 0.05) WRITE(IOUT,9905)                               FZRF
      WRITE(IOUT,9902) U,W, OBS(NO)                                      FZRF
      UL=U                                                               FZRF
      NO=NO+1                                                            FZRF
      IF(NO.LE.NOLIM) GOTO 110                                           FZRF
      IF (NC .LE. NCALC) GO TO 110                                       FZRF
  300 RETURN                                                             FZRF
 9901 FORMAT(1H ,F10.2,F10.3,2X,3I4,F8.1)                                FZRF
 9902 FORMAT(1H ,F10.2,F10.3,14H     *OBSERVED ,F8.1)                    FZRF
 9903 FORMAT(53H0LIST OF ALL OBSERVED AND CALCULATED LINES UP TO THE ,   FZRF
     1 I2,3H-TH/74H IF THE TWOTHETAS DIFFER MORE THAN 0.05 DEGREES, A BL FZRF
     2ANK LINE IS INSERTED.)                                             FZRF
 9904 FORMAT(45H0  TWOTHETA       D       H   K   L     Q          )     FZRF
 9905 FORMAT(3X)                                                         FZRF
      END                                                                FZRF
      SUBROUTINE MINV(A,N,D,L,M)                                         FZRF
C                                                                        FZRF
C  MATRIX INVERSION. COPIED FROM THE I.B.M. SCIENTIFIC SUBROUTINE PACKAG FZRF
C                                                                        FZRF
      DIMENSION A(36),L(6),M(6)                                          FZRF
      D=1.0                                                              FZRF
      NK=-N                                                              FZRF
      DO 80 K=1,N                                                        FZRF
      NK=NK+N                                                            FZRF
      L(K)=K                                                             FZRF
      M(K)=K                                                             FZRF
      KK=NK+K                                                            FZRF
      BIGA=A(KK)                                                         FZRF
      DO 20 J=K,N                                                        FZRF
      IZ=N*(J-1)                                                         FZRF
      DO 20 I=K,N                                                        FZRF
      IJ=IZ+I                                                            FZRF
   10 IF(ABS(BIGA).GE.ABS(A(IJ))) GO TO 20                               FZRF
      BIGA=A(IJ)                                                         FZRF
      L(K)=I                                                             FZRF
      M(K)=J                                                             FZRF
   20 CONTINUE                                                           FZRF
      J=L(K)                                                             FZRF
      IF(J .LE. K) GO TO 35                                              FZRF
      KI=K-N                                                             FZRF
      DO 30 I=1,N                                                        FZRF
      KI=KI+N                                                            FZRF
      HOLD=-A(KI)                                                        FZRF
      JI=KI-K+J                                                          FZRF
      A(KI)=A(JI)                                                        FZRF
      A(JI)=HOLD                                                         FZRF
   30 CONTINUE                                                           FZRF
   35 I=M(K)                                                             FZRF
      IF(I .LE. K) GO TO 45                                              FZRF
      JP=N*(I-1)                                                         FZRF
      DO 40 J=1,N                                                        FZRF
      JK=NK+J                                                            FZRF
      JI=JP+J                                                            FZRF
      HOLD=-A(JK)                                                        FZRF
      A(JK)=A(JI)                                                        FZRF
      A(JI)=HOLD                                                         FZRF
   40 CONTINUE                                                           FZRF
   45 IF (ABS(BIGA) .GT. 0.0001) GO TO 48                                FZRF
      D=0.0                                                              FZRF
      RETURN                                                             FZRF
   48 DO 55 I=1,N                                                        FZRF
      IF(I .EQ. K) GO TO 55                                              FZRF
      IK=NK+I                                                            FZRF
      A(IK)=A(IK)/(-BIGA)                                                FZRF
   55 CONTINUE                                                           FZRF
      DO 65 I=1,N                                                        FZRF
      IK=NK+I                                                            FZRF
      HOLD=A(IK)                                                         FZRF
      IJ=I-N                                                             FZRF
      DO 65 J=1,N                                                        FZRF
      IJ=IJ+N                                                            FZRF
      IF(I .EQ. K) GO TO 65                                              FZRF
      IF(J .EQ. K) GO TO 65                                              FZRF
      KJ=IJ-I+K                                                          FZRF
      A(IJ)=HOLD*A(KJ)+A(IJ)                                             FZRF
   65 CONTINUE                                                           FZRF
      KJ=K-N                                                             FZRF
      DO 75 J=1,N                                                        FZRF
      KJ=KJ+N                                                            FZRF
      IF(J .EQ. K) GO TO 75                                              FZRF
      A(KJ)=A(KJ)/BIGA                                                   FZRF
   75 CONTINUE                                                           FZRF
      D=D*BIGA                                                           FZRF
      A(KK)=1.0/BIGA                                                     FZRF
   80 CONTINUE                                                           FZRF
      K=N                                                                FZRF
  100 K=(K-1)                                                            FZRF
      IF(K .LE. 0) GO TO 150                                             FZRF
      I=L(K)                                                             FZRF
      IF(I .LE. K) GO TO 120                                             FZRF
      JQ=N*(K-1)                                                         FZRF
      JR=N*(I-1)                                                         FZRF
      DO 110 J=1,N                                                       FZRF
      JK=JQ+J                                                            FZRF
      HOLD=A(JK)                                                         FZRF
      JI=JR+J                                                            FZRF
      A(JK)=-A(JI)                                                       FZRF
      A(JI)=HOLD                                                         FZRF
  110 CONTINUE                                                           FZRF
  120 J=M(K)                                                             FZRF
      IF(J .LE. K) GO TO 100                                             FZRF
      KI=K-N                                                             FZRF
      DO 130 I=1,N                                                       FZRF
      KI=KI+N                                                            FZRF
      HOLD=A(KI)                                                         FZRF
      JI=KI-K+J                                                          FZRF
      A(KI)=-A(JI)                                                       FZRF
      A(JI)=HOLD                                                         FZRF
  130 CONTINUE                                                           FZRF
      GO TO 100                                                          FZRF
  150 RETURN                                                             FZRF
      END                                                                FZRF
      SUBROUTINE NORM3                                                   FZRF
C----------------------------------------------------------------------- FZRF
C  THIS SUBROUTINE 'NORMALIZES THE LATTICES AND PUTS THEM INTO A         FZRF
C  STANDARD SHAPE                                                        FZRF
C----------------------------------------------------------------------- FZRF
C                                                                        FZRF
      DIMENSION  OLD(6),          IZON(3,6),QVAL(5,5,5)                  FZRF
      INTEGER H,H1                                                       FZRF
      LOGICAL SELF,ENL,TEST,LIST,CHANGE                                  FZRF
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
      COMMON /PARMS / TOL2,TOL3,WAVEL,FMINEQ,FMINIM,SELF,ENL,TEST,LIST,  FZRF
     *                NSYST(3),OBSMT(40),OBSPT(40)                       FZRF
      EQUIVALENCE (CEL(1),A),(CEL(2),B),(CEL(3),C),(CEL(4),D),           FZRF
     *(CEL(5),E),(CEL(6),F),(FMINEQ,EQMIN)                               FZRF
      DO 80 I=1,6                                                        FZRF
   80 OLD(I)=CEL(I)                                                      FZRF
C  INITIALIZING *OLD*                                                    FZRF
      GO TO 100                                                          FZRF
C                                                                        FZRF
C----------------------------------------------------------------------- FZRF
C  THE NEXT PART IS THE OLD PROCEDURE 'MAZEN'                            FZRF
C  MAZEN FINDS THE  VALUES OF D,E AND F IN A LATTICE, WHEN THE COORDINAT FZRF
C  OF A,B,AND C HAVE BEEN GIVEN.                                         FZRF
   10 I1=IZON(H,1)+IZON(K,1)-3                                           FZRF
      I2=IZON(H,2)+IZON(K,2)-3                                           FZRF
      I3=IZON(H,3)+IZON(K,3)-3                                           FZRF
      X=QVAL(I1,I2,I3)                                                   FZRF
      I1=IZON(H,1)-IZON(K,1)+3                                           FZRF
      I2=IZON(H,2)-IZON(K,2)+3                                           FZRF
      I3=IZON(H,3)-IZON(K,3)+3                                           FZRF
      Y=QVAL(I1,I2,I3)                                                   FZRF
      Z=(X-Y)/2.0                                                        FZRF
      GO TO (601,602,603),ISW                                            FZRF
C----------------------------------------------------------------------- FZRF
C                                                                        FZRF
C                                                                        FZRF
C----------------------------------------------------------------------- FZRF
C  THE FOLLOWING IS THE PROCEDURE 'CHANGE'                               FZRF
C  IF ANY CONSTANT HAS BEEN  CHANGED,THE PROGRAM REPEATS UNTIL NO        FZRF
C  MORE CHANGES ARE DETECTED.                                            FZRF
   20 U=0.0                                                              FZRF
      DO 30 I=1,6                                                        FZRF
      U=U+ ABS(CEL(I)   -OLD(I))                                         FZRF
      OLD(I)=CEL(I)                                                      FZRF
   30 CONTINUE                                                           FZRF
      CHANGE=.FALSE.                                                     FZRF
      IF (U.GT.0.1 ) CHANGE=.TRUE.                                       FZRF
      GO TO (310,610),ISW                                                FZRF
C----------------------------------------------------------------------- FZRF
C                                                                        FZRF
  100 IF (TEST) WRITE(IOUT,9930) A,B,C,D,E,F                             FZRF
      QMAX=10000.0                                                       FZRF
C--CHECK ON  CERTAIN RELATIONS BETWEEN A,B,C,D,E,F  WHICH MEAN THAT      FZRF
C--THE LATTICE HAS HIGHER SYMMETRY.                                      FZRF
  200 DO 300 II=1,3                                                      FZRF
      X=A                                                                FZRF
      A=B                                                                FZRF
      B=C                                                                FZRF
      C=X                                                                FZRF
      X=D                                                                FZRF
      D=E                                                                FZRF
      E=F                                                                FZRF
      F=X                                                                FZRF
      IF (B .LT. FMINIM) GO TO 1000                                      FZRF
      IF (D.GT. 0.0)  GO TO 205                                          FZRF
      D=-D                                                               FZRF
      E=-E                                                               FZRF
  205 IF (E.GT. 0.0)  GO TO 210                                          FZRF
      E=-E                                                               FZRF
      F=-F                                                               FZRF
  210 IF (ABS(A-C).LT.EQMIN  .AND.   E.GT. EQMIN) GO TO 220              FZRF
      GO TO 230                                                          FZRF
  220 A=(A+C+E)/4.                                                       FZRF
      C=A-E/2.                                                           FZRF
      F=(D+F)/2.                                                         FZRF
      D=ABS(D-F)                                                         FZRF
      E=0                                                                FZRF
  230 IF (ABS(E-A).GT.EQMIN ) GO TO 240                                  FZRF
      A=A/4.                                                             FZRF
      C=C-A                                                              FZRF
      E=0.0                                                              FZRF
      F=F/2.                                                             FZRF
      D=ABS(D-F)                                                         FZRF
  240 IF (ABS(E-C).GT.EQMIN) GO TO 250                                   FZRF
      C=C/4.0                                                            FZRF
      A=A-C                                                              FZRF
      E=0.0                                                              FZRF
      D=D/2.                                                             FZRF
      F=ABS(D-F)                                                         FZRF
  250 IF (ABS(D) .LE. EQMIN) D=0.0                                       FZRF
      IF (ABS(E) .LE. EQMIN) E=0.0                                       FZRF
      IF (ABS(F) .LE. EQMIN) F=0.0                                       FZRF
  300 CONTINUE                                                           FZRF
      IF (TEST) WRITE(IOUT,9931) A,B,C,D,E,F                             FZRF
      ISW=1                                                              FZRF
      GO TO 20                                                           FZRF
C--TEST ON CHANGES.                                                      FZRF
  310 IF (CHANGE) GO TO 200                                              FZRF
C--CALCULATE  THE Q-VALUES NEAR THE ORIGIN                               FZRF
      DO 400 L1=3,4                                                      FZRF
      L=L1-3                                                             FZRF
      DO 390 K1=2,4                                                      FZRF
      K=K1-3                                                             FZRF
      DO 380 H1=2, 4                                                     FZRF
      H=H1-3                                                             FZRF
      IF (L  .EQ.0 .AND. K .LT.1) GO TO 330                              FZRF
      X=A*FLOAT(H*H)+B*FLOAT(K*K)+C*FLOAT(L*L)+D*FLOAT(K*L)+E*FLOAT(H*L) FZRF
     1  +F*FLOAT(H*K)                                                    FZRF
      IF (X .GT.(-0.1))GO TO 320                                         FZRF
      A=0.0                                                              FZRF
      GO  TO  1000                                                       FZRF
  320 QVAL (H1,K1,L1)=X                                                  FZRF
      GO TO 380                                                          FZRF
  330 QVAL(H1,K1,L1)=QMAX                                                FZRF
  380 CONTINUE                                                           FZRF
  390 CONTINUE                                                           FZRF
  400 CONTINUE                                                           FZRF
      QVAL(4,3,3) =A                                                     FZRF
C--NOW FIND THE SMALLEST Q-VALUES.                                       FZRF
      N1=0                                                               FZRF
  410 N1=N1+1                                                            FZRF
      U=QMAX-10.0                                                        FZRF
      DO 500 L=3,4                                                       FZRF
      DO 490 K=2,4                                                       FZRF
      DO 480 H=2,4                                                       FZRF
      IF (QVAL(H,K,L).GE.U) GO TO 480                                    FZRF
      U=QVAL(H,K,L)                                                      FZRF
      IZON(N1,3)=L                                                       FZRF
      IZON(N1,1)=H                                                       FZRF
      IZON(N1,4)=H                                                       FZRF
      IZON(N1,2)=K                                                       FZRF
      IZON(N1,5)=K                                                       FZRF
  480 CONTINUE                                                           FZRF
  490 CONTINUE                                                           FZRF
  500 CONTINUE                                                           FZRF
      I1=IZON(N1,1)                                                      FZRF
      I2=IZON(N1,2)                                                      FZRF
      I3=IZON(N1,3)                                                      FZRF
      QVAL(I1,I2,I3)=QMAX                                                FZRF
      IF (N1.LT.3) GO TO 410                                             FZRF
C--CHECK WHETHER THEY ARE IN ONE PLANE.                                  FZRF
      II=0                                                               FZRF
      DO  510 I=1,3                                                      FZRF
      K=IZON(1,I+1)-3                                                    FZRF
      L=IZON(2,I+2)-3                                                    FZRF
      M=IZON(2,I+1)-3                                                    FZRF
      N=IZON(1,I+2)-3                                                    FZRF
      J=K*L-M*N                                                          FZRF
      II=II+J*(IZON(3,I)-3)                                              FZRF
  510 CONTINUE                                                           FZRF
      IF (II .NE. 0) GO TO 520                                           FZRF
      N1=2                                                               FZRF
      GO TO  410                                                         FZRF
C--CALCULATE THE RECIPROCAL LATTICE AGAIN., TO DETERMINE D,E, AND F.     FZRF
  520 DO 580 L1=1,5                                                      FZRF
      L=L1-3                                                             FZRF
      DO 570 K1=1,5                                                      FZRF
      K=K1-3                                                             FZRF
      DO 560 H1=1,5                                                      FZRF
      H=H1-3                                                             FZRF
      Q=A*FLOAT(H*H)+B*FLOAT(K*K)+C*FLOAT(L*L)+D*FLOAT(K*L)+E*FLOAT(H*L) FZRF
     1  +F*FLOAT(H*K)                                                    FZRF
      IF (Q .GT.(-0.1)) GO TO 550                                        FZRF
      A=0.0                                                              FZRF
      GO TO 1000                                                         FZRF
C  IF ANY Q-VALUE IS NEGATIVE,THE LATTICE SHOULD BE DISCARDED            FZRF
  550 QVAL(H1,K1,L1)=Q                                                   FZRF
  560 CONTINUE                                                           FZRF
  570 CONTINUE                                                           FZRF
  580 CONTINUE                                                           FZRF
      I11=IZON(1,1)                                                      FZRF
      I12=IZON(1,2)                                                      FZRF
      I13=IZON(1,3)                                                      FZRF
      I21=IZON(2,1)                                                      FZRF
      I22=IZON(2,2)                                                      FZRF
      I23=IZON(2,3)                                                      FZRF
      I31=IZON(3,1)                                                      FZRF
      I32=IZON(3,2)                                                      FZRF
      I33=IZON(3,3)                                                      FZRF
      B=QVAL(I11,I12,I13)                                                FZRF
      A=QVAL(I21,I22,I23)                                                FZRF
      C=QVAL(I31,I32,I33)                                                FZRF
C  I KNOW, IKNOW,    BUT THIS PIDGIN-FORTRAN WORKS ON ALL MACHINES....   FZRF
C--NOW FIND D,E AND F.                                                   FZRF
      ISW=1                                                              FZRF
      H=1                                                                FZRF
      K=3                                                                FZRF
      GO TO  10                                                          FZRF
  601 D=Z                                                                FZRF
      ISW=2                                                              FZRF
      K=2                                                                FZRF
      GO TO 10                                                           FZRF
  602 F=Z                                                                FZRF
      ISW=3                                                              FZRF
      H=3                                                                FZRF
      GO TO 10                                                           FZRF
  603 E=Z                                                                FZRF
      IF (TEST) WRITE(IOUT,9934) (CEL(I),I=1,6)                          FZRF
      ISW=2                                                              FZRF
      GO TO 20                                                           FZRF
C--TEST ON CHANGES.                                                      FZRF
  610 IF (CHANGE) GO TO 200                                              FZRF
C--FROM HERE TO LABEL 670, H COUNTS THE NUMBER OF TERMS AMONG D,E,F      FZRF
C--THAT ARE EQUAL TO ZERO, WHILE K POINTS OUT WHICH ONE IF THERE         FZRF
C--IS ONLY ONE.                                                          FZRF
      H=0                                                                FZRF
      IF (ABS(D).GT.EQMIN) GO TO 620                                     FZRF
      D=0.0                                                              FZRF
      GO TO  621                                                         FZRF
  620 H=H+1                                                              FZRF
      K=1                                                                FZRF
  621 IF (ABS(E).GT.EQMIN) GO TO 630                                     FZRF
      E=0.0                                                              FZRF
      GO TO 631                                                          FZRF
  630 H=H+1                                                              FZRF
      K=2                                                                FZRF
  631 IF (ABS(F).GT.EQMIN) GO TO 640                                     FZRF
      F=0.0                                                              FZRF
      GO TO 641                                                          FZRF
  640 H=H+1                                                              FZRF
      K=3                                                                FZRF
  641 IF (H.NE. 1)  GO  TO  670                                          FZRF
      IF (K.NE. 1)  GO  TO  650                                          FZRF
C--REARRANGE INTO STANDARD MONOCLINIC SETTING.                           FZRF
      U=A                                                                FZRF
      A=B                                                                FZRF
      B=U                                                                FZRF
      E=ABS(D)                                                           FZRF
      D=0.0                                                              FZRF
      F=0.0                                                              FZRF
  650 IF (K .NE.3)  GO TO 660                                            FZRF
C--REARRANGE INTO STANDARD MONOCLINIC SETTING.                           FZRF
      U=A                                                                FZRF
      A=B                                                                FZRF
      B=C                                                                FZRF
      C=U                                                                FZRF
      E=ABS(F)                                                           FZRF
      D=0.0                                                              FZRF
      F=0.0                                                              FZRF
  660 IF (E .LE.A) GO TO 670                                             FZRF
      C=A+C-E                                                            FZRF
      E=A+A-E                                                            FZRF
C--ADJUST THE SIGNS OF TRICLINIC COSINE TERMS SO THAT ONLY QF CAN BE -VE FZRF
  670 IF (D .GT.(-0.1))   GO TO 675                                      FZRF
      D=-D                                                               FZRF
      E=-E                                                               FZRF
  675 IF (E .GT. (-0.1) ) GO TO 680                                      FZRF
      E=-E                                                               FZRF
      F=-F                                                               FZRF
  680 IF (H.EQ.3 .AND. ABS(A+B+F-D-E) .LT. EQMIN ) GO TO 690             FZRF
C--THIS IS A MONOCLINIC LATTICE IN DISGUISE.                             FZRF
      GO TO 700                                                          FZRF
  690 E=(A-B)*0.5                                                        FZRF
      A=(A+B+F)/4.                                                       FZRF
      B=C-A                                                              FZRF
      C=A-F/2.                                                           FZRF
      D=0.0                                                              FZRF
      F=0.0                                                              FZRF
C  THIS WAS THE TRANSFORMATION OF CERTAIN MONOCLINIC CENTERED LATTICES.  FZRF
 700  CONTINUE                                                           FZRF
      IF (TEST) WRITE(IOUT,9935) (CEL(I),I=1,6)                          FZRF
 1000 RETURN                                                             FZRF
 9930 FORMAT(11H LATTICE IS, 6F8.1)                                      FZRF
 9931 FORMAT(11H REDUCED   , 6F8.1)                                      FZRF
 9934 FORMAT(11H REDUCED2  ,6F8.1)                                       FZRF
 9935 FORMAT(11H REDUCED3  , 6F8.1)                                      FZRF
      END                                                                FZRF
      SUBROUTINE READER(NZ1,NZ2,NR,WMOL,DOBS)                            FZRF
C  --------------------------------------------------------------------- FZRF
C----THE FIRST CARD MUST CONTAIN THE NAME OF THE PROBLEM (TITLE).        FZRF
C    THE NEXT CARD IS USUALLY COMPLETELY BLANK. THE PROGRAM              FZRF
C    THEN TAKES THE DEFAULT VALUES.. IF YOU WANT TO SPECIFY YOUR         FZRF
C    OWN PARAMETERS, YOU SHOULD DO THIS AS FOLLOWS0                      FZRF
C  COLUMN  FORMAT  NAME   DEFAULT   MEANING                              FZRF
C    1      A1     MAN      0       PRINTS INSTRUCTIONS,UNLESS MAN=9     FZRF
C    2      A1     INSTR    0       PRINTS INSTRUCTIONS FOR SPECIAL      FZRF
C                                   FEATURES IF INSTR=1                  FZRF
C    3      A1     INTENS   0       READS INTENSITIES BESIDES LINE       FZRF
C                                   POSITIONS IF INTENS=1                FZRF
C   5- 6    I2     NSYST(1) 0       ORTHORHOMBIC SOLUTION. +1=YES, -1=NO FZRF
C   7- 8    I2     NSYST(2) 0       MONOCLINIC SYSTEM.   0 MEANS  INDIFF FZRF
C   9-10    I2     NSYST(3) 0       TRICLINIC SYSTEM                     FZRF
C  11-15   F5.2    TOL2    3.0      TOLERANCE ON 2-DIMENSIONAL SEARCH    FZRF
C  16-20   F5.2    TOL3    4.5      TOLERANCE ON 3-DIMENSIONAL SEARCH    FZRF
C  21-30   F10.5   WAVEL   1.5405   WAVELENGTH                           FZRF
C  31-32    I2     LINCO    0       NUMBER OF GIVEN LINE COMBINATIONS    FZRF
C                                   FOR THE 2-DIMENSIONAL SEARCH         FZRF
C  33-34    I2     K (ENL)  0       ENL0 OUTPUT OF INTERMEDIATE RESULTS( FZRF
C  35-36    I2     NQ1      3       NQ1 AND NQ2 DETERMINE THE NUMBERS OF FZRF
C  37-38    I2     NQ2      6       LINES TO BE USED IN COMBINATIONS     FZRF
C                                   FOR FINDING ZONES .                  FZRF
C  39-40    I2     NZ1      6       NZ1 AND NZ2 DO THE SAME FOR          FZRF
C  41-42    I2     NZ2      6       FINDING LATTICES FROM ZONES.         FZRF
C  43-44    I2     NR       0       REFINEMENT AND EVALUATION RUN ONLY   FZRF
C                                   IF NR>0. THE DECK OF COMPLETE        FZRF
C                                   LATTICES TO BE REFINED (6F10.2)      FZRF
C                                   WILL FOLLOW THE LINES DECK, ALSO     FZRF
C                                   TERMINATED BY A CARD WITH ZERO OR    FZRF
C                                   BLANKS IN COLS 1-10.                 FZRF
C  45-46    I2     INP      5       NUMBER OF THE UNIT ON WHICH TO READ  FZRF
C                                   THE LINE POSITIONS.                  FZRF
C  47-48    I2     LST      0       LIST OF CALCULATED LINES IF LST=1    FZRF
C  49-50    I2     J (TEST) 0       TEST OUTPUT IF J>0                   FZRF
C  51-60   F10.5   WMOL    0.0      MOLECULAR WEIGHT.                    FZRF
C  61-70   F10.5   DOBS    0.0      OBSERVED DENSITY.                    FZRF
C  71-80   F10.5   TOLG    3.0      TOLERANCE ON MATCH BETWEEN CALCULATE FZRF
C                                   AND OBSERVED Q-VALUES.               FZRF
C  --------------------------------------------------------------------- FZRF
C  --------------------------------------------------------------------- FZRF
      DIMENSION QIN(200),IIN(200),INTY(8),ISYST(3,3)                     FZRF
      LOGICAL SELF,ENL,TEST,LIST                                         FZRF
CDC---LEVEL STATEMENTS FOR CDC 7600 FOLLOW---REMOVE FOR OTHER MACHINES-- LEV2
CDC   LEVEL 2, LINCO,NQ2,NSOLMX,ROSTER                                   FZRFL2
C---COMMON BLOCK /TEMRES/, LENGTH 11613 (OCTAL), 5003 (DECIMAL)          FZRFL2
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
      COMMON /PARMS / TOL2,TOL3,WAVEL,FMINEQ,FMINIM,SELF,ENL,TEST,LIST,  FZRF
     *                NSYST(3),OBSMT(40),OBSPT(40)                       FZRF
      COMMON /TEMRES/ LINCO,NQ2,NSOLMX,ROSTER(500,10)                    FZONRFM
      DATA ISYST(1,1)/4HORTH/,ISYST(1,2)/4HORHO/,ISYST(1,3)/4HMBIC/,     FZRF
     1     ISYST(2,1)/4HMONO/,ISYST(2,2)/4HCLIN/,ISYST(2,3)/4HIC  /,     FZRF
     2     ISYST(3,1)/4HTRIC/,ISYST(3,2)/4HLINI/,ISYST(3,3)/4HIC   /     FZRF
      DATA NEND1/4HEND /,NEND2/4H END/                                   FZRF
      DATA NINE/1H9/,IONE/1H1/,IBLA/3H   /                               FZRF
C  --------------------------------------------------------------------- FZRF
C  --------------------------------------------------------------------- FZRF
C  AFTER THE PARAMETER CARD WE MUST ENTER THE LINES,  EITHER AS          FZRF
C  TWOTHETA, D- OR Q- VALUES.                                            FZRF
C  THE PROGRAM WILL FIND OUT WHAT KIND OF VALUES IT HAS.                 FZRF
C  THE NUMBER OF LINES MUST BE AT LEAST 20  AND MUST NOT EXCEED 200.     FZRF
C  A MAXIMUM OF 40 LINES IS ACTUALLY USED, THE REST IS HARMLESS.         FZRF
C  ONLY THE FIRST SIX LINES SHOULD BE IN THEIR CORRECT ORDER, THE REST   FZRF
C  CAN BE ENTERED IN A RANDOM WAY.  EVEN LINES THAT SHOULD BE AMONG      FZRF
C  THE FIRST SIX CAN BE ENTERED LATER.                                   FZRF
C  THE LINES CARDS SHOULD BE TERMINATED BY A BLANK CARD.                 FZRF
C  THE PROGRAM TESTS ON THIS  BLANK CARD AND THEN COUNTS THE NUMBER      FZRF
C  OF REFLECTIONS.                                                       FZRF
C  --------------------------------------------------------------------- FZRF
 9990 CONTINUE                                                           FZRF
C  --------------------------------------------------------------------- FZRF
C--IF YOU SET LINCO  UNEQUAL  ZERO YOU MUST NOW ADD LINCO CARDS.         FZRF
C  THERE ARE SEVERAL POSSIBILITIES0                                      FZRF
C  A. YOU ENTER TWO Q-VALUES (2F10.5) PER CARD.                          FZRF
C    IN THIS CASE THE PROGRAM TREATS THEM AS ONE OF HIS OWN              FZRF
C    LINE COMBINATIONS AND TRIES TO FIND THE ANGLE IN FINZON  ETC.       FZRF
C  B. YOU ENTER THREE CONSTANTS (3F10.5).                                FZRF
C     THE PROGRAM RECOGNIZES THIS AS A COMPLETE ZONE, BUT WILL           FZRF
C     DETERMINE THE QUALITY OF THIS ZONE. THIS MAY LEAD TO AN            FZRF
C     UNEXPECTED DOUBLING OF AXES.                                       FZRF
C     NOTE0 A RECTANGULARZONE MUST BE ENTERED AS  A,B, 0.1  FOR READING  FZRF
C     IN CORRECTLY.  THE PROGRAM WILL VERY SOON  REPLACE 0.1 BY 0.0      FZRF
C  C. YOU ENTER 4 VALUES  (4F10.5).  THE FOURTH VALUE IS THE             FZRF
C     QUALITY OF THE ZONE.  IF YOU SET THIS HIGH ENOUGH, THE ZONE        FZRF
C     WILL CERTAINLY BE USED IN LATTICE-FINDING.                         FZRF
C     ENTERING A SINGLE DIGIT IN COLUMN 31 ASSURES YOU OF A HIGH QUALITY FZRF
C  --------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
C                                                                        FZRF
      IOUT=38                                                            FZRF
C---OUTPUT FROM =READER= IS DISCARDED BY DIVERTING IT TO CHANNEL 8       FZRF
      CEL(10)=0.                                                         FZRF
      JOB=JOB+1                                                          FZRF
      CALL ECHO                                                          FZRF
      READ(INP,9901)  NAME                                               FZRF
C     READ(INP,9901,END=9999)  NAME           (IBM ONLY)                 FZRF
C  FOR   IBM MACHINES THE TRICK WITH THE  END  CARD IS NOT NECESSARY.    FZRF
      IF( NAME(1) .EQ.NEND1)GOTO 9999                                    FZRF
      IF( NAME(1) .EQ.NEND2)GOTO 9999                                    FZRF
      RAD=57.29578                                                       FZRF
      DO 6 I=1,8                                                         FZRF
    6 INTY(I)=IBLA                                                       FZRF
      DO 7 I=1,200                                                       FZRF
    7 IIN(I)=IBLA                                                        FZRF
      DO 8 I=1,40                                                        FZRF
    8 INTSY(I)=IBLA                                                      FZRF
      TOLG=3.                                                            FZRF
      ENL=.TRUE.                                                         FZRF
      TEST=.TRUE.                                                        FZRF
      LIST=.FALSE.                                                       FZRF
      SELF=.FALSE.                                                       FZRF
      CALL ECHO                                                          FZRF
      READ(INP,9902) MAN,INSTR,INTENS,NSYST,TOL2,TOL3,WAVEL,LINCO,K,     FZRF
     * NQ1,NQ2,NZ1,NZ2,NR,INP,LST,J,WMOL,DOBS,TOLG                       FZRF
C--PARAMETER CARD                                                        FZRF
      IF(NR.GT.0) GOTO 9                                                 FZRF
      IOUT=6                                                             FZRF
      WRITE(IOUT,9000)                                                   FZRF
 9000 FORMAT(27H0NO SOLUTIONS TO BE REFINED/)                            FZRF
      GOTO 9999                                                          FZRF
    9 CONTINUE                                                           FZRF
      WRITE(IOUT,9920) NAME                                              FZRF
      WRITE(IOUT,9950)                                                   FZRF
      IF (TOL2.LT. 0.1) TOL2=3.0                                         FZRF
      IF (TOL3.LT. 0.1) TOL3=4.5                                         FZRF
      IF (WAVEL.LT.0.1) WAVEL=1.54050                                    FZRF
      IF ( K   .EQ. 0) ENL =.FALSE.                                      FZRF
      IF (NQ1 .EQ. 0) NQ1=3                                              FZRF
      IF (NQ2 .EQ. 0) NQ2=6                                              FZRF
      IF (NZ1 .EQ. 0) NZ1=6                                              FZRF
      IF (NZ2 .EQ. 0) NZ2=6                                              FZRF
      IF (INP .EQ. 0) INP=39                                             FZRF
      IF (LST .EQ. 1) LIST=.TRUE.                                        FZRF
      IF ( J   .EQ. 0) TEST=.FALSE.                                      FZRF
      IF (TEST) SELF=.TRUE.                                              FZRF
      IF (TOLG .LT. 0.1) TOLG=3.0                                        FZRF
      L=0                                                                FZRF
   10 CONTINUE                                                           FZRF
      CALL ECHO                                                          FZRF
      IF (INTENS .EQ. IONE) GO TO 12                                     FZRF
      READ(INP,9903)  (CEL(J),J=1,8)                                     FZRF
      GO TO 14                                                           FZRF
   12 READ(INP,9912)  (  CEL(J),INTY(J)  ,J=1,8)                         FZRF
   14 U=0.0                                                              FZRF
      DO 15 I=1,8                                                        FZRF
   15 U=U+ABS(CEL(I) )                                                   FZRF
C  IT IS POSSIBLE TO GET RID OF A LINE BY SIMPLY PUNCHING A MINUS  SIGN  FZRF
C  IN FRONT OF THE VALUE(PROVIDED THERE WAS ENOUGH SPACE IN THE FORMAT). FZRF
C  THIS TRICK NOW ALSO WORKS WITH ONLY ONE LINE PER CARD.                FZRF
      IF (U .LT. 0.1) GO TO 30                                           FZRF
      DO  20 I=1,8                                                       FZRF
      IF (CEL(I) .LT. 0.1) GOTO 20                                       FZRF
      L=L+1                                                              FZRF
      QIN(L)  =CEL(I)                                                    FZRF
      IIN(L)=INTY(I)                                                     FZRF
   20 CONTINUE                                                           FZRF
      GO TO 10                                                           FZRF
C----------------------------------------------------------------------- FZRF
C--END OF READING LINES CARDS                                            FZRF
C----------------------------------------------------------------------- FZRF
   30 L=L+1                                                              FZRF
      DO 40 I=1,8                                                        FZRF
      MAX=L-I                                                            FZRF
      IF (QIN(MAX) .GT. 0.1) GO TO 90                                    FZRF
   40 CONTINUE                                                           FZRF
      GO TO 90                                                           FZRF
   90 CONTINUE                                                           FZRF
      WRITE(IOUT, 9918)  MAX                                             FZRF
      WRITE(IOUT, 9915) ( QIN(M),IIN(M) ,M=1,MAX)                        FZRF
C----------------------------------------------------------------------- FZRF
C--WE NOW KNOW THE NUMBER OF LINES. NEXT WE TRY TO FIND OUT,             FZRF
C--WHAT KIND OF VALUES WE HAVE  AND PRINT THEM OUT.                      FZRF
C----------------------------------------------------------------------- FZRF
      IF (MAX .GE. 40) MAX=40                                            FZRF
      DO 150 I=1,8                                                       FZRF
  150 CEL(I)=QIN(I)                                                      FZRF
      DO 160 M=1,5                                                       FZRF
      IF(CEL(M+1) .LT. CEL(M)) GO TO 180                                 FZRF
  160 CONTINUE                                                           FZRF
C----------------------------------------------------------------------- FZRF
C--IF INPUT IS IN DESCENDING ORDER, WE HAVE  D-VALUES                    FZRF
C----------------------------------------------------------------------- FZRF
      DO 170 M=1,MAX                                                     FZRF
      OBS(M)=QIN(M)                                                      FZRF
      INTSY(M)=IIN(M)                                                    FZRF
  170 CONTINUE                                                           FZRF
      ISTYG=1                                                            FZRF
      CALL SRTRON(ISTYG)                                                 FZRF
      IF(OBS(MAX) .GE. 180.0) GO TO 290                                  FZRF
C----------------------------------------------------------------------- FZRF
C--IF THE LAST INPUT VALUE IS GREATER THAN 180 WE DO NOT HAVE TWOTHETAS. FZRF
C----------------------------------------------------------------------- FZRF
      A=WAVEL/200.0                                                      FZRF
      B=1.0/(A*A)                                                        FZRF
      C=1.0/(2.0*RAD)                                                    FZRF
      WRITE(IOUT,9906)                                                   FZRF
      WRITE(IOUT,9909)                                                   FZRF
      DO 280 M=1,MAX                                                     FZRF
      W=OBS(M)                                                           FZRF
      D=SIN(C*W)                                                         FZRF
      OBS(M)=B*D*D                                                       FZRF
  280 CONTINUE                                                           FZRF
      WRITE(IOUT,9911)  WAVEL                                            FZRF
      GO TO 300                                                          FZRF
  290 CONTINUE                                                           FZRF
      WRITE(IOUT,9921)  MAX                                              FZRF
      WRITE(IOUT,9906)                                                   FZRF
      WRITE(IOUT,9908)                                                   FZRF
      GO TO 302                                                          FZRF
  180 DO 200 M=1,MAX                                                     FZRF
      OBS(M)=QIN(M)                                                      FZRF
      INTSY(M)=IIN(M)                                                    FZRF
  200 CONTINUE                                                           FZRF
      ISTYG=0                                                            FZRF
      CALL SRTRON(ISTYG)                                                 FZRF
      WRITE(IOUT,9906)                                                   FZRF
      WRITE(IOUT,9907)                                                   FZRF
      DO 210 M=1,MAX                                                     FZRF
      OBS(M)=10000.0/(OBS(M)*OBS(M))                                     FZRF
  210 CONTINUE                                                           FZRF
  300 WRITE(IOUT,9921)  MAX                                              FZRF
      WRITE(IOUT,9910)                                                   FZRF
  302 WRITE(IOUT,9916)  ( OBS(M),INTSY(M) ,M=1,MAX)                      FZRF
      IF (MAX .GE. 20 ) GO  TO 305                                       FZRF
      WRITE(IOUT, 9930) MAX                                              FZRF
      GO TO 9990                                                         FZRF
  305 CONTINUE                                                           FZRF
C----------------------------------------------------------------------- FZRF
C--THE ARRAY OF Q-VALUES HAS NOW BEEN ESTABLISHED.                       FZRF
C----------------------------------------------------------------------- FZRF
      ST=1.0E-3*TOLG                                                     FZRF
      IF (TEST) WRITE(IOUT,9936)                                         FZRF
      DO 306 M=1,MAX                                                     FZRF
      W=OBS(M)                                                           FZRF
      T=TOLG                                                             FZRF
      IF (W .GT. 1000.) T=ST*W                                           FZRF
      OBSMT(M)=W-T                                                       FZRF
      OBSPT(M)=W+T                                                       FZRF
      IF (TEST) WRITE(IOUT,9937) W,OBSMT(M),OBSPT(M)                     FZRF
  306 CONTINUE                                                           FZRF
C--THE RANGE FOR MATCHING Q-VALUES HAS BEEN SET                          FZRF
      IF (NQ1 .LE. NQ2) GO TO 308                                        FZRF
      I=NQ2                                                              FZRF
      NQ2=NQ1                                                            FZRF
      NQ1=I                                                              FZRF
  308 IF (NZ1 .LE. NZ2) GO TO 309                                        FZRF
      I=NZ2                                                              FZRF
      NZ2=NZ1                                                            FZRF
      NZ1=I                                                              FZRF
  309 FMINIM=1.                                                          FZRF-2
C--- FMINIM HAS BEEN CHANGED FROM 0.1*OBS(1) IN ORDER TO INHIBIT         FZRF-2
C--- THE TEST ON MINIMUM QA,QB,QC WHEN INCORPORATED INTO S/R FZONRF      FZRF-2
      FMINEQ=OBS(20)*5.0E-4                                              FZRF
      IF (FMINEQ .LT. 0.8)  FMINEQ=0.8                                   FZRF
      A=4.0 *FMINEQ                                                      FZRF
      C=2.0*FMINEQ                                                       FZRF
      DO 310 M=2,MAX                                                     FZRF
      B=OBS(M)-OBS(M-1)                                                  FZRF
      IF  (B .GT. A) GO TO 310                                           FZRF
      A=B                                                                FZRF
      IF ( B .GE. C) GO TO 310                                           FZRF
      I=M-1                                                              FZRF
      D=RAD*WAVEL*B/( 200.0*SQRT(OBS(M)))                                FZRF
      WRITE(IOUT,9914) I,B,D                                             FZRF
  310 CONTINUE                                                           FZRF
      FMINEQ=0.25*A                                                      FZRF
      IF (TEST) ENL=.TRUE.                                               FZRF
      IF (.NOT. ENL) WRITE(IOUT,9927)                                    FZRF
      IF (ENL .AND. (.NOT. TEST)  ) WRITE(IOUT,9923)                     FZRF
      IF (TEST) WRITE(IOUT, 9924)                                        FZRF
      WRITE (IOUT,9925) FMINIM                                           FZRF
      WRITE(IOUT,9926) FMINEQ                                            FZRF
      WRITE(IOUT,9922) TOL2,TOL3                                         FZRF
      IF (ABS(TOLG-3.0) .GT. 0.01) WRITE(IOUT,9928) TOLG                 FZRF
      IF (NR.EQ.0) GOTO 315                                              FZRF
C----------------------------------------------------------------------- FZRF
C---READ THE COMPLETE LATTICES (REFINEMENT RUN ONLY)                     FZRF
      WRITE(IOUT,9941)                                                   FZRF
      I=0                                                                FZRF
      IOUT=6                                                             FZRF
C---REINSTATE IOUT IN ORDER TO PRINT THE LIST OF SOLUTIONS AS INPUT      FZRF
      WRITE(IOUT,9312)                                                   FZRF
 9312 FORMAT(48H1** LIST OF CELLS TO BE REFINED AND EVALUATED **//)      FZRF
  311 CALL ECHO                                                          FZRF
      READ(INP,9940) (CEL(J),J=1,6)                                      FZRF
      IF (CEL(1).EQ.0.) GOTO 314                                         FZRF
      I=I+1                                                              FZRF
      IF (I.GT.NSOLMX) GOTO 313                                          FZRF
      DO 312 J=1,6                                                       FZRF
  312 ROSTER(I,J)=CEL(J)                                                 FZRF
      ROSTER(I,7)=99                                                     FZRF
      ROSTER(I,8)=I                                                      FZRF
  313 IF (I.EQ.NSOLMX+1) WRITE(IOUT,9943) NSOLMX                         FZRF
      WRITE(IOUT, 9942) I,(CEL(J),J=1,6)                                 FZRF
      GOTO 311                                                           FZRF
  314 NR=I                                                               FZRF
      IF (NR.GT.NSOLMX) NR=NSOLMX                                        FZRF
      WRITE(IOUT,9944) NR                                                FZRF
  315 CONTINUE                                                           FZRF
      IOUT=8                                                             FZRF
C---SUPPRESS OUTPUT AGAIN                                                FZRF
  500 CONTINUE                                                           FZRF
      DO 510 N=1,3                                                       FZRF
  510 IF (NSYST(N) .EQ. 1) WRITE(IOUT,9952) (ISYST(N,I),I=1,3)           FZRF
      WRITE(IOUT,9934) WMOL                                              FZRF
      WRITE(IOUT,9935) DOBS                                              FZRF
      IOUT=6                                                             FZRF
C---HAVE NOW FINISHED DISCARDING OUTPUT                                  FZRF
      RETURN                                                             FZRF
 9999 WRITE(IOUT,9998)                                                   FZRF
      NR=-1                                                              FZRF
      RETURN                                                             FZRF
C----------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
C  THE FOLLOWING CARDS ARE USEFUL FOR TEST PURPOSES0                     FZRF
C     WRITE(IOUT,9945) TOL2,TOL3,TOLG,WAVEL,LINCO,SELF,ENL,TEST,         FZRF
C    * NQ1,NQ2,NZ1,NZ2 ,NR,INP,WMOL,DOBS                                 FZRF
C9945 FORMAT(53H   TOL2  TOL3  TOLG  WAVEL   LINCO   SELF   ENL  TEST,   FZRF
C    *33H NQ1 NQ2 NZ1 NZ2 NR INP WMOL DOBS/                              FZRF
C    *  3F6.1, F8.5, I8, 3L6,    6I4 ,2F8.5)                             FZRF
C----------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
C----------------------------------------------------------------------- FZRF
 9901 FORMAT(20A4)                                                       FZRF
 9902 FORMAT(3A1,1X,3I2,2F5.2,F10.5,4I2,2I1,I4,3I2,3F10.5)               FZRF
 9903 FORMAT( 8F10.5 )                                                   FZRF
 9906 FORMAT(23H0THE INPUT CONSISTED OF   )                              FZRF
 9907 FORMAT(1H+, 23X,10H D-VALUES.)                                     FZRF
 9908 FORMAT(1H+, 23X,10H Q-VALUES.)                                     FZRF
 9909 FORMAT(1H+, 23X,12H TWO THETAS. )                                  FZRF
 9910 FORMAT(45H0THE INPUT LEADS TO THE FOLLOWING Q-VALUES   )           FZRF
 9911 FORMAT(20H0THE WAVELENGTH IS  , F8.4)                              FZRF
 9912 FORMAT( 8(F7.3,A3) )                                               FZRF
 9914 FORMAT(40H0XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      /          FZRF
     * 41H THE DIFFERENCE IN Q-VALUES BETWEEN LINE ,  I3,                FZRF
     * 22H AND THE NEXT IS ONLY  , F6.2 /                                FZRF
     * 14H THIS IS ONLY  ,F5.2,  18H DEGREES TWO THETA     /             FZRF
     * 40H            PLEASE  CHECK  YOUR  INPUT     /                   FZRF
     * 56H THE PROGRAM WILL CONTINUE, BUT MAY NOT GIVE THE CORRECT,      FZRF
     * 59H ANSWERS SINCE THE LIMIT FOR  'EQUAL' VALUES CAN BE TOO LOW /  FZRF
     * 40H XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      )                FZRF
 9915 FORMAT( 10(1X,F8.3,1X,A3)  )                                       FZRF
 9916 FORMAT( 10(1X,F7.1,2X,A3)  )                                       FZRF
 9917 FORMAT(15H INPUT ZONE NR., I3, 4F8.1)                              FZRF
 9918 FORMAT(37H0THE INPUT CONSISTED OF THE FOLLOWING,I4,7H LINES   )    FZRF
 9919 FORMAT(3F10.2, F10.1)                                              FZRF
 9920 FORMAT(50H1THIS PROGRAM TRIES TO FIND THE UNITCELL FROM THE ,      FZRF
     *18H POWDER PATTERN OF ///20X,20A4///26H WITH A METHOD PROPOSED BY, FZRF
     *61H  DE WOLFF AND PROGRAMMED BY VISSER (J.APPL.CRYST.2,89(1969))/  FZRF
     *40H            FORTRAN  VERSION    6         )                     FZRF
 9921 FORMAT(41H0THE NUMBER OF LINES THAT WILL BE USED IS ,I4)           FZRF
 9922 FORMAT(43H0(COL 11-15)THE TOLERANCE ON THE TRIAL F IS, F4.1//      FZRF
     *44H (COL 16-20) THE TOLERANCE ON THE TRIAL D IS , F4.1)            FZRF
 9923 FORMAT(38H0INTERMEDIATE RESULTS ARE PRINTED OUT./                  FZRF
     * 58H PUNCH A 1 IN COLUMN 50 OF THE PARAMETER CARD IF YOU WANT  ,   FZRF
     * 18H THE TEST OUTPUT.   )                                          FZRF
 9924 FORMAT(39H0TESTRUN, ALL TEST RESULTS ARE PRINTED.)                 FZRF
 9925 FORMAT(44H0THE LOWER LIMIT FOR THE VALUES OF A,B,C IS ,  F8.2)     FZRF
 9926 FORMAT(66H0VALUES WILL BE CONSIDERED TO BE EQUAL WHEN THEY DIFFER  FZRF
     * LESS THAN , F4.1 )                                                FZRF
 9927 FORMAT(55H0ONLY A MINIMUM OF INTERMEDIATE RESULTS WILL BE PRINTED/ FZRF
     * 59H PUNCH A 1 IN COLUMN 34 OF THE PARAMETER CARD IF YOU WANT  ,   FZRF
     * 14H MORE OUTPUT.  )                                               FZRF
 9928 FORMAT(48H ***********************************************/        FZRF
     1       40H * THE OVERALL TOLERANCE IS CHANGED INTO,F6.2,2H */      FZRF
     2       48H *********************************************** )       FZRF
 9930 FORMAT(32H0THE NUMBER OF USEFUL LINES  IS ,I4 /                    FZRF
     *60H SINCE THIS IS LESS THAN THE MINIMUM NUMBER OF LINES THAT TH ,  FZRF
     *60HE PROGRAM NEEDS (20),YOU CANNOT EXPECT RELIABLE  RESULTS.   //  FZRF
     *24H THIS PROBLEM IS SKIPPED  )                                     FZRF
 9931 FORMAT(21H0THE PROGRAM WILL USE ,I3,24H GIVEN LINE COMBINATIONS)   FZRF
 9932 FORMAT(35H0THE PROGRAM WILL COMBINE THE FIRST ,I3,                 FZRF
     * 21H LINES WITH THE FIRST  ,I3)                                    FZRF
 9933 FORMAT(42H0THE PROGRAM WILL TRY TO COMBINE THE FIRST  ,I3,         FZRF
     * 21H ZONES WITH THE FIRST ,I3)                                     FZRF
 9934 FORMAT(30H0THE GIVEN MOLECULAR WEIGHT IS,  F10.3)                  FZRF
 9935 FORMAT(30H0THE GIVEN OBSERVED DENSITY IS,  F10.4)                  FZRF
 9936 FORMAT(63H0THE Q-VALUES WITH THEIR LIMITS OF ERROR,Q +/- TOLERANCE FZRF
     1 (TOLG)/ 32H       Q        Q-TOL     Q+TOL    )                   FZRF
 9937 FORMAT(1H ,3F10.1)                                                 FZRF
 9940 FORMAT( 8F10.2 )                                                   FZRF
 9941 FORMAT(57H0INPUT OF COMPLETE LATTICES FOLLOWS (REFINEMENT RUN ONLY FZRF
     1)/)                                                                FZRF
 9942 FORMAT(18H INPUT LATTICE NR., I3, 8F10.2 )                         FZRF
 9943 FORMAT(1H0,40H** EXCEEDS STORAGE ALLOCATED, ONLY FIRST,I4,         FZRF
     1 21H WILL BE PROCESSED **/)                                        FZRF
 9944 FORMAT(30H0LATTICE INPUT FINISHED: FIRST,I4,18H WILL BE PROCESSED) FZRF
 9950 FORMAT(65H0******************************************************* FZRF
     1*********/  2H *,62X,1H*/ 65H *   ARE YOUR INPUT DATA REALLY THE B FZRF
     2EST THAT CAN BE OBTAINED   */2H *,62X,1H*/   65H ***************** FZRF
     3***********************************************    ///             FZRF
     480H FINDING THE UNIT CELL  DEPENDS FOR 95 PERCENT ON THE QUALITY O FZRF
     5F THE INPUT DATA./118H A RANDOM ERROR OF 0.03 DEGREES TWOTHETA CAN FZRF
     6 USUALLY BE TOLERATED, BUT A SYSTEMATIC (ZERO POINT) ERROR OF 0.02 FZRF
     7 DEGREES/77H IS PROBABLY DISASTROUS.  CHECK YOUR INPUT LINES AGAIN FZRF
     8ST THEIR HIGHER ORDERS.//  83H DO NOT USE A DEBIJE-SCHERRER CAMERA FZRF
     9  UNLESS THE UNIT CELL TO BE EXPECTED IS SMALL./76H WOULD YOU LIKE FZRF
     O TO SOLVE A JIGSAW PUZZLE WHEN HALF THE PIECES ARE MISSING---)     FZRF
 9952 FORMAT(15H0LATTICES WITH , 3A4, 35H SYMMETRY WILL GET AN EXTRA CHA FZRF
     *NCE  )                                                             FZRF
 9998 FORMAT(16H END OF PROGRAM   )                                      FZRF
      END                                                                FZRF
      SUBROUTINE REFPAR(NSOL)                                            FZRF
C----------------------------------------------------------------------- FZRF
C--REFPAR REFINES  THE PARAMETERS, PRINTS OUT THE LATTICE IF ENL=.TRUE.  FZRF
C--AND PRINTS OUT A LIST OF   TWOTHETA,D,Q,H,K,L.                        FZRF
C----------------------------------------------------------------------- FZRF
      DIMENSION HULP(6),VAR(6),FYN(6),WE(10),WAR(6),QQSTOR(100),         FZRF
     1 MATR1(6),MATR2(6),REF(6,6)                                        FZRF
      DIMENSION KSTOR(20,5),LSTOR(20,5),QSTOR(20,5),INSTOR(100,3)        FZRF
      INTEGER HSTOR(20,5)                                                FZRF
      INTEGER TELOB(25),BR(21,5),P,  H,H1,HS,HMIN,HMAX,HMAX1,            FZRF
     1 COUNT,ORDE                                                        FZRF
      LOGICAL SELF,ENL,TEST,LIST                                         FZRF
      LOGICAL HEVEN,KEVEN,LEVEN,REPEAT,MIS,DRUK,PRIN,NOPRIN,LIST2        FZRF
      LOGICAL FIRST4,IGOOD,MGOOD,ROUND2                                  FZRF
      REAL M20MIN                                                        FZRF
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
      COMMON /PARMS / TOL2,TOL3,WAVEL,FMINEQ,FMINIM,SELF,ENL,TEST,LIST,  FZRF
     *                NSYST(3),OBSMT(40),OBSPT(40)                       FZRF
      COMMON /LINSTR/ INSTOR,QQSTOR                                      FZRF
      COMMON /REFP/ IREF                                                 FZRF
      EQUIVALENCE (INSTOR(1,1),HSTOR(1,1)),(INSTOR(1,2),KSTOR(1,1)),     FZRF
     1  (INSTOR(1,3),LSTOR(1,1)),(QQSTOR(1),QSTOR(1,1) )                 FZRF
C----------------------------------------------------------------------- FZRF
      SWAVEL=WAVEL/200.0                                                 FZRF
      QMAX=OBS(20)*(1.0+0.002*TOL3)                                      FZRF
      LIST2=.FALSE.                                                      FZRF
      ROUND2=IREF.EQ.0                                                   FZRF
      FIRST4=NSOL.LE.4                                                   FZRF
      I20MIN=15                                                          FZRF
      M20MIN=7.0                                                         FZRF
      IGOOD=CEL(7).GE.I20MIN                                             FZRF
      MGOOD=CEL(8).GE.M20MIN                                             FZRF
      IBRAV=6                                                            FZRF
      DRUK=.FALSE.                                                       FZRF
      DRUK= ROUND2 .AND. (FIRST4 .OR. MGOOD)                             FZRF
      IF (CEL(7) .LT. 2.0) GO TO 90                                      FZRF
C--THE FIRST TIME THAT REFPAR IS CALLED, CEL(7)=0.                       FZRF
      IBRAV= CEL(9)                                                      FZRF
   90 CONTINUE                                                           FZRF
      REPEAT=.TRUE.                                                      FZRF
      IVORDE=7                                                           FZRF
      PRIN= DRUK .AND. ENL .AND. MGOOD                                   FZRF
      NOPRIN=.NOT. PRIN                                                  FZRF
      GO TO 100                                                          FZRF
   95 IF ( (.NOT. DRUK) .AND. REPEAT)  CALL NORM3                        FZRF
  100 NIET=0                                                             FZRF
      ISPAT=1                                                            FZRF
      ORDE=3                                                             FZRF
      DO 110 J=4,6                                                       FZRF
      IF (ABS(CEL(J)) .GT. 0.5) GO TO 105                                FZRF
      CEL(J)=0.                                                          FZRF
      GO TO 110                                                          FZRF
  105 ORDE=ORDE+1                                                        FZRF
  110 CONTINUE                                                           FZRF
      IF (IVORDE .EQ. ORDE) REPEAT=.NOT. REPEAT                          FZRF
      IVORDE=ORDE                                                        FZRF
      IF (ORDE .NE. 5) GO TO 200                                         FZRF
      IF (ABS(CEL(6)) .LT. 0.1) GO TO 180                                FZRF
      IF (ABS(CEL(4)) .LT. 0.1) GO TO 160                                FZRF
      CALL WISSEL(2,3)                                                   FZRF
      GO  TO 180                                                         FZRF
  160 CALL WISSEL(1,3)                                                   FZRF
  180 IF (ABS(CEL(5)).LT. ABS(CEL(4))) CALL WISSEL(1,2)                  FZRF
  200 CONTINUE                                                           FZRF
      DO 211 I=1,21                                                      FZRF
      DO 210 J=1,5                                                       FZRF
  210 BR(I,J)=0                                                          FZRF
      TELOB(I)=0                                                         FZRF
  211 CONTINUE                                                           FZRF
  220 IF (DRUK) WRITE(IOUT,9916)  NAME,NSOL                              FZRF
      IF (PRIN) WRITE(IOUT,9926) (CEL(J),J=1,10)                         FZRF
      IF (TEST .AND. NOPRIN) WRITE(IOUT,9926) (CEL(J),J=1,10)            FZRF
C                                                                        FZRF
C                 START GENERATING  Q-VALUES                             FZRF
C                                                                        FZRF
      NN=0                                                               FZRF
      ASQ=CEL(1)                                                         FZRF
      BSQ=CEL(2)                                                         FZRF
      CSQ=CEL(3)                                                         FZRF
      ALFA=CEL(4)                                                        FZRF
      BETA=CEL(5)                                                        FZRF
      GAMMA=CEL(6)                                                       FZRF
      HMAX=INT(SQRT(QMAX/ASQ))+1                                         FZRF
      KMAX=INT(SQRT(QMAX/BSQ))+1                                         FZRF
      LMAX=INT(SQRT(QMAX/CSQ))+1                                         FZRF
      N20=0                                                              FZRF
      KEVEN=.FALSE.                                                      FZRF
      LMIN=-LMAX                                                         FZRF
      IF(ORDE .EQ. 3) LMIN=0                                             FZRF
      HMIN=0                                                             FZRF
      IF(ORDE .GE. 5) HMIN=-HMAX                                         FZRF
      IF (PRIN) WRITE(IOUT,9917)                                         FZRF
      KMAX1=KMAX+1                                                       FZRF
C  K-LOOP STARTS HERE                                                    FZRF
      DO 1050 K1=1,KMAX1                                                 FZRF
      K=K1-1                                                             FZRF
      RK=K                                                               FZRF
      IF(NOPRIN) GO TO 520                                               FZRF
      WRITE(IOUT,9918)  K                                                FZRF
      ISPAT=1                                                            FZRF
  520 C1=RK*RK*BSQ                                                       FZRF
      C2=RK*ALFA                                                         FZRF
      C3=RK*GAMMA                                                        FZRF
      KEVEN=.NOT. KEVEN                                                  FZRF
      HS=HMIN                                                            FZRF
      IF(K .EQ.  0) HS=0                                                 FZRF
      HEVEN=.TRUE.                                                       FZRF
      IF(2*(HS/2) .EQ. HS) HEVEN=.FALSE.                                 FZRF
      HMAX1=HMAX-HS+1                                                    FZRF
C  H-LOOP STARTS HERE                                                    FZRF
      DO 1040 H1=1,HMAX1                                                 FZRF
      H=H1+HS-1                                                          FZRF
      RH=H                                                               FZRF
      C4=C1+RH*(C3+RH*ASQ)                                               FZRF
      C5=C2+RH*BETA                                                      FZRF
      IF(NOPRIN) GO TO 530                                               FZRF
      WRITE(IOUT,9923)                                                   FZRF
      ISPAT=1                                                            FZRF
      IF((K+IABS(H)) .EQ. 0 .AND. ORDE .GT. 4) ISPAT=ISPAT+LMAX          FZRF
      IF(ORDE .EQ. 4 . AND. H .EQ. 0) ISPAT=ISPAT+LMAX                   FZRF
  530 HEVEN=.NOT. HEVEN                                                  FZRF
      LB=LMIN                                                            FZRF
      IF(H .NE. 0) GO TO 540                                             FZRF
      IF(K .EQ. 0.OR. ORDE .EQ. 4) LB=0                                  FZRF
  540 LEVEN=.TRUE.                                                       FZRF
      IF(2*(LB/2) .EQ. LB) LEVEN=.FALSE.                                 FZRF
      LMAX1=LMAX+1-LB                                                    FZRF
C  L-LOOP STARTS HERE                                                    FZRF
      DO 1030 L1=1,LMAX1                                                 FZRF
      L=L1-1+LB                                                          FZRF
      LEVEN=.NOT. LEVEN                                                  FZRF
      Q=C4+FLOAT(L)*(C5+FLOAT(L)*CSQ)                                    FZRF
      IF (Q .GT. 1.0) GO TO 630                                          FZRF
      IF (PRIN) CALL WRISP(ISPAT,0. ,0)                                  FZRF
      GO TO 1020                                                         FZRF
  630 IF(Q .GE. QMAX) GO TO 1020                                         FZRF
      IF (.NOT. DRUK)      GO TO 700                                     FZRF
      GO TO (640,650,660,670,680,700,950),IBRAV                          FZRF
  640 IF(KEVEN.AND.LEVEN.OR..NOT.KEVEN.AND..NOT.LEVEN) GO TO 700         FZRF
      GO TO 1020                                                         FZRF
  650 IF(HEVEN.AND.LEVEN.OR..NOT.HEVEN.AND..NOT.LEVEN) GO TO 700         FZRF
      GO TO 1020                                                         FZRF
  660 IF(HEVEN.AND.KEVEN.OR..NOT.HEVEN.AND..NOT.KEVEN) GO TO 700         FZRF
      GO TO 1020                                                         FZRF
  670 IF (2*((H+K+L)/2) .EQ. H+K+L) GO TO 700                            FZRF
C--I-LATTICE                                                             FZRF
      GO TO 1020                                                         FZRF
  680 IF(HEVEN.AND.KEVEN.OR..NOT.HEVEN.AND..NOT.KEVEN) GO TO 690         FZRF
      GO TO 1020                                                         FZRF
  690 IF(KEVEN.AND.LEVEN.OR..NOT.KEVEN.AND..NOT.LEVEN) GO TO 700         FZRF
      GO TO 1020                                                         FZRF
  700 N20=N20+1                                                          FZRF
      IF (.NOT. LIST2) GO TO 720                                         FZRF
      NN=NN+1                                                            FZRF
      INSTOR(NN,1)=H                                                     FZRF
      INSTOR(NN,2)=K                                                     FZRF
      INSTOR(NN,3)=L                                                     FZRF
      QQSTOR(NN)=Q                                                       FZRF
      GO TO 1030                                                         FZRF
  720 CONTINUE                                                           FZRF
      IF (PRIN) CALL WRISP(ISPAT,Q,0)                                    FZRF
      MIS=.TRUE.                                                         FZRF
      DO 800 J=1,20                                                      FZRF
      IF (OBSPT(J) .LT. Q ) GO TO 800                                    FZRF
      IF (OBSMT(J) .GT. Q ) GO TO 950                                    FZRF
      P=J                                                                FZRF
      IF (NOPRIN) GO TO 750                                              FZRF
      CALL WRISP(ISPAT,Q,1)                                              FZRF
      MIS=.FALSE.                                                        FZRF
      GO TO 780                                                          FZRF
  750 CONTINUE                                                           FZRF
      IF(KEVEN.AND.LEVEN.OR..NOT.KEVEN.AND..NOT.LEVEN)                   FZRF
     * BR(P,1)=BR(P,1)+1                                                 FZRF
      IF(HEVEN.AND.LEVEN.OR..NOT.HEVEN.AND..NOT.LEVEN)                   FZRF
     * BR(P,2)=BR(P,2)+1                                                 FZRF
      IF(HEVEN.AND.KEVEN.OR..NOT.HEVEN.AND..NOT.KEVEN)                   FZRF
     * BR(P,3)=BR(P,3)+1                                                 FZRF
      IF (2*((H+K+L)/2) .EQ. H+K+L) BR(P,4)=BR(P,4)+1                    FZRF
      IF ((HEVEN.AND.KEVEN.OR..NOT.HEVEN.AND..NOT.KEVEN)  .AND.          FZRF
     * (KEVEN.AND.LEVEN.OR..NOT.KEVEN.AND..NOT.LEVEN))BR(P,5)=BR(P,5)+1  FZRF
  780 I=TELOB(P)+1                                                       FZRF
      IF (I .GT.  5) GO TO 800                                           FZRF
      TELOB(P)=I                                                         FZRF
      HSTOR(P,I)=H                                                       FZRF
      KSTOR(P,I)=K                                                       FZRF
      LSTOR(P,I)=L                                                       FZRF
      QSTOR(P,I)=Q                                                       FZRF
  800 CONTINUE                                                           FZRF
  950 CONTINUE                                                           FZRF
 1020 IF (PRIN) ISPAT=ISPAT+1                                            FZRF
C  END OF K,H,L-LOOP ON 1050,1040,1030 RESPECTIVELY                      FZRF
 1030 CONTINUE                                                           FZRF
      IF (PRIN) CALL WRISP(ISPAT,Q,2)                                    FZRF
 1040 CONTINUE                                                           FZRF
 1050 CONTINUE                                                           FZRF
C                                                                        FZRF
C             END GENERATING Q                                           FZRF
C                                                                        FZRF
      IF (.NOT. LIST2) GO TO 1100                                        FZRF
      CALL LISTM(NN)                                                     FZRF
       WRITE(IOUT,9941)  (CEL(J),J=1,6),N20,NAME,NSOL                    FZRF
      GO TO  1360                                                        FZRF
 1100 DO 1110 H=1,6                                                      FZRF
      DO 1105 K=1,6                                                      FZRF
 1105 REF(H,K)=0.0                                                       FZRF
 1110 CONTINUE                                                           FZRF
      DO 1120 H=1,6                                                      FZRF
      FYN(H)=0.0                                                         FZRF
      WAR(H)=0.0                                                         FZRF
 1120 CONTINUE                                                           FZRF
      T=0.0                                                              FZRF
      RMS=0.0                                                            FZRF
      SUMEPS=1.E-3                                                       FZRF
C  WHEN THE NUMBER OF LINES INDEXED  EQUALS THE NUMBER OF PARAMETERS,    FZRF
C  SUMEPS WILL KEEP ITS STARTING VALUE.  THE VALUE ZERO CAUSES ACCIDENTS FZRF
      COUNT=0                                                            FZRF
      IF (DRUK)  WRITE(IOUT,9910)                                        FZRF
      DO 1180 P=1,20                                                     FZRF
      NR=TELOB(P)                                                        FZRF
      QOBS=OBS(P)                                                        FZRF
      IF (.NOT. DRUK) GO TO 1122                                         FZRF
      W=SQRT(QOBS)                                                       FZRF
      U=SWAVEL*W                                                         FZRF
      W=100.0/W                                                          FZRF
      U=114.59156*ATAN(U/SQRT(1.0-U*U))                                  FZRF
      WRITE(IOUT,9911) U,W,QOBS,INTSY(P)                                 FZRF
 1122 CONTINUE                                                           FZRF
      IF (NR .GT. 0) GO TO 1124                                          FZRF
      IF (DRUK) WRITE(IOUT,9912)                                         FZRF
      NIET=NIET+1                                                        FZRF
      GO TO 1180                                                         FZRF
 1124 CONTINUE                                                           FZRF
      EPS=1000.0                                                         FZRF
      SUMW=0.0                                                           FZRF
      DO 1130 N=1,NR                                                     FZRF
      D=ABS(QOBS-QSTOR(P,N))                                             FZRF
      IF(D .LT. EPS)EPS=D                                                FZRF
      IF (D .GT. 9.0) D=9.0                                              FZRF
C--NECESSARY TO PREVENT UNDERFLOW ON  PDP-10 (AND UNIVAC?)               FZRF
      W=EXP(-D*D)                                                        FZRF
      WE(N)=W                                                            FZRF
      SUMW=SUMW+W                                                        FZRF
 1130 CONTINUE                                                           FZRF
      SUMEPS=SUMEPS+EPS                                                  FZRF
      DO 1170 N=1,NR                                                     FZRF
      H=HSTOR(P,N)                                                       FZRF
      K=KSTOR(P,N)                                                       FZRF
      L=LSTOR(P,N)                                                       FZRF
      Q=QSTOR(P,N)                                                       FZRF
      IF (.NOT. DRUK) GO TO 1042                                         FZRF
      W=SQRT(Q)                                                          FZRF
      U=SWAVEL*W                                                         FZRF
      W=100.0/W                                                          FZRF
      U=114.59156*ATAN(U/SQRT(1.0-U*U))                                  FZRF
      WRITE(IOUT,9914) U,W,Q,H,K,L                                       FZRF
 1042 CONTINUE                                                           FZRF
      DIF=QOBS-Q                                                         FZRF
      COUNT=COUNT+1                                                      FZRF
      W=WE(N)/SUMW                                                       FZRF
      RMS=RMS+W*DIF*DIF                                                  FZRF
      T=T+W                                                              FZRF
      VAR(1)=H*H                                                         FZRF
      VAR(2)=K*K                                                         FZRF
      VAR(3)=L*L                                                         FZRF
      VAR(4)=H*L                                                         FZRF
      VAR(5)=K*L                                                         FZRF
      VAR(6)=H*K                                                         FZRF
      DO 1150 J=1,ORDE                                                   FZRF
      HULP(J)=W*VAR(J)                                                   FZRF
      WAR(J)=WAR(J)+W*DIF*VAR(J)                                         FZRF
 1150 CONTINUE                                                           FZRF
      DO 1160 J=1,ORDE                                                   FZRF
      DO 1155 I=1,ORDE                                                   FZRF
 1155 REF(I,J)=REF(I,J)+VAR(I)*HULP(J)                                   FZRF
 1160 CONTINUE                                                           FZRF
 1170 CONTINUE                                                           FZRF
 1180 CONTINUE                                                           FZRF
      CALL ARRAY(2,ORDE,ORDE,6,6,REF,REF)                                FZRF
      CALL MINV(REF,ORDE,DETER,MATR1,MATR2)                              FZRF
      CALL ARRAY(1,ORDE,ORDE,6,6,REF,REF)                                FZRF
      IF (ABS(DETER) .GE. 0.001) GO TO 1185                              FZRF
      IF (TEST) WRITE(IOUT,9931)                                         FZRF
      GO TO 1210                                                         FZRF
 1185 IF(T .GT. FLOAT(ORDE+1)) RMS=RMS/(T-FLOAT(ORDE))                   FZRF
      DO 1195 I=1,ORDE                                                   FZRF
      DO 1190 J=1,ORDE                                                   FZRF
 1190 FYN(I)=FYN(I)+REF(I,J)*WAR(J)                                      FZRF
 1195 CONTINUE                                                           FZRF
      DO 1200 N=1,3                                                      FZRF
 1200 CEL(N)=CEL(N)+FYN(N)                                               FZRF
      IF (ORDE .GT. 3) CEL(5)=CEL(5)+FYN(4)                              FZRF
      IF (ORDE .GT. 4) CEL(4)=CEL(4)+FYN(5)                              FZRF
      IF (ORDE .GT. 5) CEL(6)=CEL(6)+FYN(6)                              FZRF
 1210 NIET=20-NIET                                                       FZRF
      IF (DRUK) GO TO 1350                                               FZRF
      IF (REPEAT) GO TO 95                                               FZRF
      DO 1320 J=1,5                                                      FZRF
      N=0                                                                FZRF
      DO 1310 M=1,20                                                     FZRF
 1310 IF (BR(M,J) .GT. 0 ) N=N+1                                         FZRF
      BR(21,J)=N                                                         FZRF
 1320 CONTINUE                                                           FZRF
      IBRAV=6                                                            FZRF
      DO 1330 J=1,5                                                      FZRF
      IF ( BR(21,J) .GE. NIET) IBRAV=J                                   FZRF
 1330 CONTINUE                                                           FZRF
 1350 CEL(7)=NIET                                                        FZRF
      CEL(9)=IBRAV                                                       FZRF
      CEL(8)=FLOAT(NIET)*OBS(20)/(FLOAT(2*N20)*SUMEPS)                   FZRF
      IF (PRIN) WRITE(IOUT,9940) (CEL(J),J=7,10)                         FZRF
      IF (DRUK) WRITE(IOUT,9941)  (CEL(J),J=1,6),N20,NAME,NSOL           FZRF
      LIST2=LIST .AND. DRUK                                              FZRF
      LIST2=LIST2.AND.FIRST4.AND.MGOOD                                   FZRF
      PRIN=.FALSE.                                                       FZRF
      NOPRIN=.TRUE.                                                      FZRF
      IF (LIST2 .AND. (N20 .LE. 100) ) GO TO 220                         FZRF
      IF (LIST2) WRITE(IOUT,9942) N20                                    FZRF
 1360 RETURN                                                             FZRF
 9910 FORMAT(41H0TWOTHETA     D       Q       H    K    L)               FZRF
 9911 FORMAT(1H0, F8.2, F8.3, F9.1, 18H    *OBSERVED**    ,A3)           FZRF
 9912 FORMAT(1H+,45X ,  12H NOT INDEXED)                                 FZRF
 9914 FORMAT(1H ,F8.2,F8.3,F9.1, 3I5)                                    FZRF
 9916 FORMAT(1H1,20A4,14H   SOLUTION NR,I3)                              FZRF
 9917 FORMAT(36H0LATTICE PRINTED OUT FOR INSPECTION //                   FZRF
     156H DISPLAYED IN LAYERS UP --K-- ,    --L-- ACROSS THE PAGE,       FZRF
     222H --H-- DOWN THE PAGE.   //)                                     FZRF
 9918 FORMAT( 8H ***  H ,I2,8H  L  ***   // )                            FZRF
 9923 FORMAT(1H0)                                                        FZRF
 9926 FORMAT(1H ,6F9.2, F9.0,F9.1, 2F9.0 )                               FZRF
 9931 FORMAT(1H ,14X,19HMATRIX IS SINGULAR )                             FZRF
 9940 FORMAT(1H0//14H LINES INDEXED,F5.0,16H FIGURE OF MERIT, F8.1,      FZRF
     *13H LATTICE TYPE, F6.0, 9H PEDIGREE,F8.0)                          FZRF
 9941 FORMAT(1H0//46H RECIPROCAL LATTICE CONSTANTS AFTER REFINEMENT/     FZRF
     * 6F9.2, 5H N20=,I4 ///1H ,20A4,14H   SOLUTION NR, I3)              FZRF
 9942 FORMAT(35H0THE NUMBER OF CALCULATED LINES IS  ,I4,                 FZRF
     *50H. NO LISTING IS PRINTED WHEN N20 IS MORE THAN 100   /           FZRF
     * 30H SEE END OF SUBROUTINE REFPAR  )                               FZRF
      END                                                                FZRF
      SUBROUTINE SRTRON(ISTYG)                                           FZRF
C                                                                        FZRF
C                                                                        FZRF
C     THIS SUBPROGRAM SORTS THE TWOTHETA-,D- OR Q-VALUES (POSSIBLY       FZRF
C     TOGETHER WITH INTENSITIES).THE TWOTHETA- OR Q-VALUES ARE PUT IN    FZRF
C     INCREASING ORDER,THE D-VALUES IN DECREASING ORDER.                 FZRF
C                                                                        FZRF
C     ISTYG=1 - DATA ARE TWOTHETA- OR Q-VALUES (TO PUT IN INCREASING     FZRF
C               ORDER).                                                  FZRF
C     ISTYG=0 - DATA ARE D-VALUES (TO PUT IN DECREASING ORDER).          FZRF
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
C                                                                        FZRF
      FAKTOR=1.0                                                         FZRF
      IF(ISTYG.EQ.0)FAKTOR=-1.0                                          FZRF
   20 IEIND=MAX-1                                                        FZRF
C                                                                        FZRF
      DO 70 I=1,IEIND                                                    FZRF
      IF(FAKTOR*(OBS(I+1)-OBS(I)))30,70,70                               FZRF
   30 OBSTR=OBS(I+1)                                                     FZRF
      IINT=INTSY(I+1)                                                    FZRF
      DO 40 J=1,I                                                        FZRF
C                                                                        FZRF
      IF(FAKTOR*(OBSTR-OBS(J)))50,40,40                                  FZRF
   40 CONTINUE                                                           FZRF
C                                                                        FZRF
   50 MEIND=I+1-J                                                        FZRF
C                                                                        FZRF
      DO 60 M=1,MEIND                                                    FZRF
      K=I+1-M                                                            FZRF
      OBS(K+1)=OBS(K)                                                    FZRF
      INTSY(K+1)=INTSY(K)                                                FZRF
   60 CONTINUE                                                           FZRF
      OBS(J)=OBSTR                                                       FZRF
      INTSY(J)=IINT                                                      FZRF
   70 CONTINUE                                                           FZRF
      DO 80 I=1,IEIND                                                    FZRF
      IF (ABS(OBS(I+1)-OBS(I) ) .GT. 0.0001) GO TO 80                    FZRF
      WRITE(IOUT,99) OBS(I)                                              FZRF
      OBS(I+1)=OBS(MAX)                                                  FZRF
      INTSY(I+1)=INTSY(MAX)                                              FZRF
      MAX=MAX-1                                                          FZRF
      GO TO 20                                                           FZRF
   80 CONTINUE                                                           FZRF
C                                                                        FZRF
      RETURN                                                             FZRF
   99 FORMAT(41H0XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   /            FZRF
     * 17H THE INPUT VALUE  ,F10.5, 15H APPEARS TWICE   /                FZRF
     * 27H           CHECK YOUR INPUT    /                               FZRF
     * 41H XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   )                  FZRF
      END                                                                FZRF
      SUBROUTINE  SYMTST                                                 FZRF
C  SUBROUTINE SYMTEST TRIES TO FIND OUT WHETHER THE LATTICES FOUND       FZRF
C  ARE LATTICES OF A HIGHER SYMMETRY IN DISGUISE.                        FZRF
      DIMENSION NAM(3,2)                                                 FZRF
      INTEGER  H                                                         FZRF
      LOGICAL SELF,ENL,TEST,LIST                                         FZRF
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
      COMMON /PARMS / TOL2,TOL3,WAVEL,FMINEQ,FMINIM,SELF,ENL,TEST,LIST,  FZRF
     *                NSYST(3),OBSMT(40),OBSPT(40)                       FZRF
      EQUIVALENCE(CEL(1),A),(CEL(2),B),(CEL(3),C),(CEL(5),E)             FZRF
      DATA NAM/4HIS P,4HROBA,4HBLY ,4H   M,4HIGHT,4H BE /                FZRF
      NPASS=0                                                            FZRF
      DIFMIN=FMINEQ                                                      FZRF
      IF (CEL(4)+ABS(CEL(6)) .GT. FMINEQ) GO TO 3010                     FZRF
   5  DIFMIN=3.0*DIFMIN                                                  FZRF
      NPASS=NPASS+1                                                      FZRF
      IF ( E .LT. FMINEQ) GO TO 1000                                     FZRF
C  THE NEXT PART   FINDS OUT WHETHER A MONOCLINIC LATTICE IS A DISGUISED FZRF
C  RHOMBOHEDRIC LATTICE.                                                 FZRF
      AA=A                                                               FZRF
      IF (ABS(E-2.*B) .GT. DIFMIN) GO TO 20                              FZRF
      IF (ABS(C-3.*B) .GT. DIFMIN) GO TO 10                              FZRF
      GO TO 200                                                          FZRF
   10 IF (ABS(A-3.*B) .GT. DIFMIN) GO TO 20                              FZRF
      AA=C                                                               FZRF
      GO TO 200                                                          FZRF
   20 IF (ABS(A+B-C) .GT. DIFMIN) GO TO 30                               FZRF
      IF (ABS(2.*ABS(B-A)-E).GT.DIFMIN) GO TO 30                         FZRF
      GO TO 200                                                          FZRF
   30 IF (ABS(B+C-4.*A).GT. DIFMIN) GO TO 40                             FZRF
      IF (ABS(E-ABS(B-C)) .GT. DIFMIN) GO TO 40                          FZRF
      GO TO 200                                                          FZRF
   40 IF (ABS(2.*C-3.*E).GT.DIFMIN) GO TO 50                             FZRF
      IF (ABS(2.*B+E-6.*A).GT. DIFMIN*FLOAT(NPASS) ) GO TO 50            FZRF
      GO TO 200                                                          FZRF
   50 IF (ABS(2.*A-3.*E) .GT. DIFMIN) GO TO 60                           FZRF
      IF (ABS(2.*B+E-6.*C).GT. DIFMIN*FLOAT(NPASS) ) GO TO 60            FZRF
      AA=C                                                               FZRF
      GO TO 200                                                          FZRF
   60 IF (NPASS .EQ. 1) GO TO 5                                          FZRF
      GO TO 3010                                                         FZRF
  200 X=B/3.0                                                            FZRF
      Z=AA-X                                                             FZRF
      IF (Z .LT. 1.) RETURN                                              FZRF
      WRITE(IOUT,900)  (CEL(J),J=1,6),(NAM(J,NPASS),J=1,3)               FZRF
      A=200./SQRT(B)                                                     FZRF
      C=100./SQRT(Z)                                                     FZRF
      WRITE(IOUT,901) X,Z, A, C                                          FZRF
      X=4.*X                                                             FZRF
      A=0.5*A                                                            FZRF
      IF (CEL(9).LT. 6.) WRITE(IOUT,902) X,A                             FZRF
      RETURN                                                             FZRF
 1000 DO 1200 I=1,2                                                      FZRF
      J=3-I                                                              FZRF
      G=CEL(J)                                                           FZRF
      H=INT(A/G+0.5 )                                                    FZRF
      K=INT(B/G+0.5 )                                                    FZRF
      L=INT(C/G+0.5 )                                                    FZRF
      IH=0                                                               FZRF
      IK=0                                                               FZRF
      IL=0                                                               FZRF
      IF (ABS(A-G*FLOAT(H)) .LT. DIFMIN) IH=1                            FZRF
      IF (ABS(B-G*FLOAT(K) ) .LT. DIFMIN) IK=1                           FZRF
      IF (ABS(C-G*FLOAT(L) ) .LT. DIFMIN) IL=1                           FZRF
      II=IH+IK+IL -2                                                     FZRF
      IF (II) 1200,1020,1010                                             FZRF
 1010 WRITE(IOUT,900)  (CEL(J),J=1,6),(NAM(J,NPASS),J=1,3)               FZRF
      X=100./SQRT(G)                                                     FZRF
      WRITE(IOUT, 911) G,X                                               FZRF
      RETURN                                                             FZRF
 1020 IF (IK*IL .EQ. 0) GO TO 1050                                       FZRF
      N=L/K                                                              FZRF
      X=B                                                                FZRF
      Z=A                                                                FZRF
      GO TO 1500                                                         FZRF
 1050 IF (IH*IL .EQ. 0) GO TO 1100                                       FZRF
      N=L/H                                                              FZRF
      X=A                                                                FZRF
      Z=B                                                                FZRF
      GO TO 1500                                                         FZRF
 1100 N=H/K                                                              FZRF
      X=B                                                                FZRF
      Z=C                                                                FZRF
      GO TO 1500                                                         FZRF
 1200 CONTINUE                                                           FZRF
C     IF (NPASS .EQ. 1) GO TO 5                                          FZRF
      GO TO 3010                                                         FZRF
 1500 WRITE(IOUT,900)  (CEL(J),J=1,6),(NAM(J,NPASS),J=1,3)               FZRF
      A=100./SQRT(X)                                                     FZRF
      C=100./SQRT(Z)                                                     FZRF
      IF (N-3) 1025,1030,1040                                            FZRF
 1025 WRITE(IOUT,912) X,Z, A,C                                           FZRF
      RETURN                                                             FZRF
 1030 A=2.0*A/SQRT(3.0)                                                  FZRF
      WRITE(IOUT,913) X,Z,A,C                                            FZRF
      RETURN                                                             FZRF
 1040 WRITE(IOUT,914) N                                                  FZRF
      RETURN                                                             FZRF
 3010 AA=OBS(MAX)                                                        FZRF
      Z=0.                                                               FZRF
      DIFMIN=FMINEQ                                                      FZRF
      DO 3020 J=1,6                                                      FZRF
      X=ABS(CEL(J))                                                      FZRF
      IF (X .LT. FMINEQ) GO TO 3020                                      FZRF
      IF (X .LT. AA) AA=X                                                FZRF
C  FINDS THE SMALLEST NON-ZERO VALUE OF THE CONSTANT, AA.                FZRF
      IF (X .GT. Z ) Z=X                                                 FZRF
C  AND THE LARGEST VALUE,  Z.                                            FZRF
 3020 CONTINUE                                                           FZRF
      DO 3050 I=1,3                                                      FZRF
      X=AA/FLOAT(I)                                                      FZRF
      IF (X .LT. 0.5*FMINIM) RETURN                                      FZRF
      L=INT(Z/X +0.5)                                                    FZRF
      X=Z/FLOAT(L)                                                       FZRF
C  REFINES THE VALUE OF THE CONSTANT BY USING THE LARGEST MULTIPLE.      FZRF
      N=0                                                                FZRF
      DO 3030 J=1,6                                                      FZRF
      G=ABS(CEL(J))                                                      FZRF
      L=INT(G/X+0.5)                                                     FZRF
      IF (ABS(G-X*FLOAT(L)) .LE. DIFMIN) N=N+1                           FZRF
 3030 CONTINUE                                                           FZRF
      IF (N .LT. 6) GO TO 3050                                           FZRF
      GO TO 3100                                                         FZRF
 3050 CONTINUE                                                           FZRF
      RETURN                                                             FZRF
 3100 WRITE(IOUT,900) (CEL(J),J=1,6),(NAM(J,2),J=1,3)                    FZRF
      Z=100./SQRT(X)                                                     FZRF
      WRITE(IOUT,911) X,Z                                                FZRF
      RETURN                                                             FZRF
  900 FORMAT(52H0THE LATTICE WITH THE RECIPROCAL LATTICE CONSTANTS0 ,    FZRF
     * 6F9.2 /1H ,3A4 )                                                  FZRF
  901 FORMAT(1H+, 12X, 24H RHOMBOHEDRAL, WITH THE   ,                    FZRF
     *45H (HEXAGONAL) RECIPROCAL LATTICE CONSTANTS0 X=,F9.2,4H  Z=,F9.2/ FZRF
     * 29H AND THE DIRECT CONSTANTS  A=, F7.4,4H  C=,F7.4 )              FZRF
  902 FORMAT(21H PROBABLY X SHOULD BE, F10.2,8H  AND A0  ,F8.4)          FZRF
  911 FORMAT(1H+,12X,44H CUBIC WITH A RECIPROCAL LATTICE CONSTANT OF  ,  FZRF
     *        F10.2,33H AND A DIRECT LATTICE CONSTANT OF , F10.4)        FZRF
  912 FORMAT(1H+,12X,42H TETRAGONAL WITH THE RECIPROCAL CONSTANTS  ,     FZRF
     * 2F10.2,29H AND THE DIRECT CONSTANTS  A=, F7.4,4H  C=,F7.4 )       FZRF
  913 FORMAT(1H+,12X,41H HEXAGONAL WITH THE RECIPROCAL CONSTANTS   ,     FZRF
     * 2F10.2,29H AND THE DIRECT CONSTANTS  A=, F7.4,4H  C=,F7.4 )       FZRF
  914 FORMAT(1H+,12X,43H A FREAK. THERE IS A RATIO IN THE CONSTANTS   ,  FZRF
     * 32H OF THE RECIPROCAL  LATTICE OF0  ,I3)                          FZRF
      END                                                                FZRF
      SUBROUTINE UNTCEL(WMOL,DOBS,VOLUM,ISW)                             FZRF
C----------------------------------------------------------------------- FZRF
C  THIS SUBROUTINE CALCULATES THE DIRECT CONSTANTS FROM THE CONSTANTS    FZRF
C  OF THE RECIPROCAL LATTICE.                                            FZRF
C  IF THE MOLECULAR WEIGHT AND THE DENSITY HAVE BEEN GIVEN,              FZRF
C  IT ALSO CALCULATES THE X-RAY DENSITY,DX,  AND THE NUMBER OF MOLECULES FZRF
C  PER UNIT CELL,  N.                                                    FZRF
C----------------------------------------------------------------------- FZRF
      DIMENSION          REC(3,6),REEL(3,6),WAAR(6)                      FZRF
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
C                                                                        FZRF
      DO 1100 J=1,6                                                      FZRF
 1100 WAAR(J)= CEL(J)                                                    FZRF
      DO 1220 J=1,3                                                      FZRF
      REC(1,J)=SQRT(WAAR(J))                                             FZRF
      REC(1,J+3)=REC(1,J)                                                FZRF
 1220 CONTINUE                                                           FZRF
      DO 1230 J=1,3                                                      FZRF
      W=WAAR(J+3)/(REC(1,J+1)*REC(1,J+2)*2.0)                            FZRF
      REC(2,J+3)=W                                                       FZRF
      REC(2,J)=W                                                         FZRF
      REC(3,J+3)=SQRT(1.0-W*W)                                           FZRF
      REC(3,J)=REC(3,J+3)                                                FZRF
 1230 CONTINUE                                                           FZRF
      DO 1240 J=1,3                                                      FZRF
      W=(REC(2,J+1)*REC(2,J+2)-REC(2,J))/(REC(3,J+1)*REC(3,J+2))         FZRF
      REEL(2,J+3)=W                                                      FZRF
      REEL(2,J)=W                                                        FZRF
      REEL(3,J)=SQRT(1.0-W*W)                                            FZRF
      REEL(3,J+3)=REEL(3,J)                                              FZRF
 1240 CONTINUE                                                           FZRF
      FNNN=REEL(3,1)*REEL(3,2)*REC(3,3)                                  FZRF
      DO 1250 J=1,3                                                      FZRF
      CEL(J)=REEL(3,J)/(FNNN*REC(1,J))*100.0                             FZRF
 1250 CONTINUE                                                           FZRF
      DO 1260 J=4,6                                                      FZRF
      CEL(J)=90.0-57.29578*ATAN(REEL(2,J)/REEL(3,J))                     FZRF
 1260 CONTINUE                                                           FZRF
      VOLUM=FNNN*CEL(1)*CEL(2)*CEL(3)                                    FZRF
      IF (ISW .EQ. 0) RETURN                                             FZRF
      WRITE(IOUT,9930) (CEL(J),J=1,6) ,VOLUM                             FZRF
      IF (WMOL .LT. 0.1) RETURN                                          FZRF
      PARTD=WMOL/(0.6025*VOLUM)                                          FZRF
      IF (DOBS .LT. 0.1) GO TO 1270                                      FZRF
      N=IFIX(1.1*DOBS/PARTD)                                             FZRF
      DX=PARTD*FLOAT(N)                                                  FZRF
      WRITE(IOUT,9931)  N,DX,DOBS                                        FZRF
      RETURN                                                             FZRF
 1270 WRITE(IOUT,9932) PARTD                                             FZRF
      RETURN                                                             FZRF
 9930 FORMAT(1H ,6F9.3,  F12.2)                                          FZRF
 9931 FORMAT(1H+,68X, 5H   Z=,I2,6H   DX=, F7.4, 8H   DOBS=, F7.4 )      FZRF
 9932 FORMAT(1H+,68X,11H   DCALC=Z*, F8.4)                               FZRF
      END                                                                FZRF
      SUBROUTINE WISSEL(I,J)                                             FZRF
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
      A=CEL(I)                                                           FZRF
      CEL(I)=CEL(J)                                                      FZRF
       CEL(J)=A                                                          FZRF
      A=CEL(I+3)                                                         FZRF
      CEL(I+3)=CEL(J+3)                                                  FZRF
      CEL(J+3)=A                                                         FZRF
      RETURN                                                             FZRF
      END                                                                FZRF
      SUBROUTINE WRISP(NPOS,VAR,ICODE)                                   FZRF
C  THE FUNCTION OF  WRISP  IS TO WRITE THE Q-VALUES OF THE CALCULATED    FZRF
C  LINES IN A NEAT SCHEME, RECOGNISABLE FOR THOSE WHO  KNOW HOW TO       FZRF
C  HANDLE THESE SCHEMES.                                                 FZRF
C     IT WRITES  VAR  (THE Q-VALUE) IN THE FORMAT F8.1, PRECEDED BY      FZRF
C  (NPOS-1)*9 SPACES.   IF THE CALCULATED VALUE OF Q CORRESPONDS TO      FZRF
C  AN OBSERVED VALUE, AN X IS ADDED LATER.                               FZRF
C                                                                        FZRF
C  THE PARAMETERS OF WRISP ARE0                                          FZRF
C  1. NPOS     = POSITION OF Q-VALUE                                     FZRF
C  2. VAR      = VALUE OF Q                                              FZRF
C  3. ICODE    = CODE TO TELL WRISP WHAT  TO DO                          FZRF
C  ICODE=0  PUT VAR IN POSITION                                          FZRF
C       =1  PUT X IN POSITION.                                           FZRF
C       =2  PRINT THE LINE WITH Q-VALUES.                                FZRF
C  THIS PARTICULAR FORM OF WRISP TAKES A LITTLE BIT OF COMPUTING TIME    FZRF
C  BUT IT IS KIND TO THE PRINTER.  IT SHOULD BE USED WHEN YOU HAVE A     FZRF
C  RELATIVELY FAST COMPUTER AND A SLOW PRINTER (E.G. A SLOW TERMINAL     FZRF
C  ON A FAST COMPUTER).                                                  FZRF
      DIMENSION IFIGRS(10),ITXT(133)                                     FZRF
      COMMON /LINES /INP,IOUT,JOB,MAX,NAME(20),INTSY(40),OBS(40),CEL(10) FZRF
      DATA IBLANK/1H /,IX/1HX/,IPNT/1H./,IFIGRS(1)/1H0/,IFIGRS(2)/1H1/,  FZRF
     * IFIGRS(3)/1H2/,IFIGRS(4)/1H3/,IFIGRS(5)/1H4/,IFIGRS(6)/1H5/,      FZRF
     2 IFIGRS(7)/1H6/,IFIGRS(8)/1H7/,IFIGRS(9)/1H8/,IFIGRS(10)/1H9/      FZRF
      DATA NUSED/0/,ISTAR/1H*/                                           FZRF
      IF (NUSED .GT. 0) GO TO 20                                         FZRF
      GO TO 400                                                          FZRF
   20 NUSED=NUSED+1                                                      FZRF
      IF (ICODE-1) 100,200,300                                           FZRF
C                                                                        FZRF
  100 IF (NPOS .LE. 14) GO TO 150                                        FZRF
C  ONLY 132 PRINT POSITIONS AVAILABLE,  15*9=135!                        FZRF
      WRITE(IOUT,9990)ITXT                                               FZRF
      NPOS=1                                                             FZRF
      DO 110 K=1,133                                                     FZRF
  110 ITXT(K)=IBLANK                                                     FZRF
  150 N=9*(NPOS-1)                                                       FZRF
      IF (VAR .GT. 0.1) GO TO 156                                        FZRF
      DO 152 I=3,9                                                       FZRF
  152 ITXT(N+I)=ISTAR                                                    FZRF
      ITXT(N+6)=IFIGRS(1)                                                FZRF
      GO TO 180                                                          FZRF
  156 NR=IFIX(VAR*10.0+0.5)                                              FZRF
      IREST=NR/10                                                        FZRF
      NFIG=NR-10*IREST                                                   FZRF
      ITXT(N+8)=IFIGRS(NFIG+1)                                           FZRF
      ITXT(N+7)=IPNT                                                     FZRF
      NR=IREST                                                           FZRF
      DO 160 I=1,6                                                       FZRF
      INR=7-I                                                            FZRF
      IREST=NR/10                                                        FZRF
      NFIG=NR-10*IREST                                                   FZRF
      NR=IREST                                                           FZRF
      ITXT(N+INR)=IFIGRS(NFIG+1)                                         FZRF
      IF (NR .EQ. 0) GO TO 180                                           FZRF
  160 CONTINUE                                                           FZRF
  180 RETURN                                                             FZRF
C                                                                        FZRF
  200 N=9*NPOS                                                           FZRF
      ITXT(N)=IX                                                         FZRF
      RETURN                                                             FZRF
C                                                                        FZRF
  300 WRITE(IOUT,9990)ITXT                                               FZRF
      NPOS=1                                                             FZRF
C                                                                        FZRF
  400 ITXT(1)=IFIGRS(1)                                                  FZRF
      DO 410 K=2,133                                                     FZRF
  410 ITXT(K)=IBLANK                                                     FZRF
      IF (NUSED .EQ. 0) GO TO 20                                         FZRF
      RETURN                                                             FZRF
 9990 FORMAT(133A1)                                                      FZRF
      END                                                                FZRF
CDC
