C                                                                        TRER
C                                                                        TRER
C     T R E O R     T R E O R     T R E O R     T R E O R                TRER
C                                                                        TRER
C     TRIAL AND ERROR PROGRAM FOR INDEXING OF UNKNOVN POWDER PATTERNS    TRER
C                                                                        TRER
C     VERSION 2  1/9-75 = VERSION 26/4 PLUS                              TRER
C                      DENS,EDENS AND MOLW. SEE KEYWORD LIST BELOW.      TRER
C                                                                        TRER
C                        P.-E.WERNER                                     TRER
C                        DEPT. OF STRUCTURAL CHEMISTRY                   TRER
C                        ARRHENIUS LABORATORY                            TRER
C                        UNIVERSITY OF STOCKHOLM                         TRER
C                        S-104 05 STOCKHOLM, SWEDEN                      TRER
C                                                                        TRER
C                                                                        TRER
C     BASIC PRINCIPLES. REF:  WERNER,P-E.,Z.KRIST. 120(1964)375-387      TRER
C                                                                        TRER
C     REFINEMENT OF UNIT CELL. REF: WERNER,P-E.,ARKIV KEMI 31(1969) 513- TRER
C                                                                        TRER
C     FIGURE OF MERIT. REF: DE WOLFF,P.M.,J.APPL.CRYST. 1(1968)108-113.  TRER
C                                                                        TRER
C                                                                        TRER
C     GENERAL COMMENTS.                                                  TRER
C     THIS IS A PRELIMINARY VERSION OF A TRIAL-AND-ERROR INDEXING PROGRA TRER
C     FOR NON-TRICLINIC X-RAY DIFFRACTION POWDER PATTERNS.               TRER
C                                                                        TRER
C     IN ORDER TO REDUCE COMPUTING TIMES ON IBM 1800 SOME PARTS OF THIS  TRER
C     PROGRAM HAVE BEEN WRITTEN FOR INTEGER CALCULATIONS.                TRER
C     I.E. THIS IS NOT A FINAL PROGRAM.                                  TRER
C                                                                        TRER
C     THE PARAMETERS GIVEN AS NORMAL VALUES IN THE KEYWORD LIST BELOW SH TRER
C     BE CONSIDERED AS AN IMPORTANT PART OF THE PROGRAM. THEY ARE BASED  TRER
C     EXPERIENCE FROM A GREAT NUMBER OF SUCCESSFUL RUNS ON STRUCTURES    TRER
C     CONFIRMED BY SINGLE CRYSTAL DATA. MOST OF THE POWDER PATTERNS USED TRER
C     BEEN OBTAINED IN FOCUSING GUINER-HAEGG CAMERAS. THE PHOTOGRAPHS HA TRER
C     BEEN MEASURED BY 1. THE METHOD DESCRIBED BY HAEGG,G. REV.SCI.INSTR TRER
C     18(1947)371 AND WESTMAN,S AND MAGNELI,A. ACTA.CHEM.SCAND. 11(1957) TRER
C                      2. THE METHOD DESCRIBED BY MALMROS,G AND WERNER,P TRER
C     ACTA.CHEM.SCAND. 27(1973)493                                       TRER
C                                                                        TRER
C     DO NOT WASTE COMPUTER TIME ON BAD DATA.                            TRER
C                                                                        TRER
C     AN INDEXING ALGORITHM CANNOT BE STATED RIGOROUSLY BECAUSE OF THE   TRER
C     UNPREDICTABLE DISTRIBUTION OF UNOBSERVED LINES AND THE ERRORS OF   TRER
C     MEASUREMENTS. THEREFORE, IT IS EXPECTED THAT VARIOUS METHODS MAY B TRER
C     USEFUL FOR VARIOUS POWDER PATTERNS. FOR EXAMPLE, A MULTITUDE OF    TRER
C     NON-SYSTEMATIC EXTINCTIONS MAY NOT APPRECIABLY AFFECT THE POWER OF TRER
C     TRIAL-AND-ERROR METHODS.                                           TRER
C                                                                        TRER
C     THE LEAST-SQUARES REFINEMENT OF THE UNIT CELL DIMENSIONS SHOULD NO TRER
C     NOT BE CONSIDERED AS AN ULTIMATE ONE. THE MAIN PURPOSE OF THE PROG TRER
C     IS TO FIND THE UNIT CELL. (CF. REF./REFINEMENT OF UNIT CELL/ GIVEN TRER
C                                                                        TRER
C     A LIMITED NUMBER OF NONSENSE CELLS MAY BE PRINTED ON THE OUTPUT LI TRER
C     YOU SHOULD LOOK FOR MAX. FIGURE OF MERIT AND MIN. NUMBER OF UNINDE TRER
C     LINES. WARNING? YOU SHOULD NOT ACCEPT UNINDEXED LOW ORDER LINES UN TRER
C     YOU ARE ABLE TO EXPLAIN THEM. ON THE OTHER HAND YOU SHOULD NOT PUT TRER
C     UNCERTAIN (DOUBTFUL) LINES IN THIS PROGRAM. THEY MAY BE TESTED LAT TRER
C     BY ANY REFINEMENT PROGRAM (EX. PROGRAM PIRUM. SEE REF. ABOVE)      TRER
C                                                                        TRER
C                                                                        TRER
C                                                                        TRER
C     THE MONITOR CARDS FOR IBM 1800 AND IBM 360/75 GIVEN BELOW APPLY TO TRER
C     THE COMPUTERS AT THE UNIVERSITY OF STOCKHOLM. SWEDEN.              TRER
C                                                                        TRER
C     MONITOR CARDS FOR IBM 1800 MPX.                                    TRER
C                                                                        TRER
C     // JOB   A    B    C    D    E    F                                TRER
C     // XEQ TREOR   FX                                                  TRER
C         INPUT DATA CARDS TO PROGRAM TREOR                              TRER
C     // END                                                             TRER
C                                                                        TRER
C                                                                        TRER
C                                                                        TRER
C                                                                        TRER
C                                                                        TRER
C     JOB CONTROL LANGUAGE EXAMPLE FOR IBM 360/75 OS.                    TRER
C                                                                        TRER
C     //TRIAL JOB (JLL304,5,1,2),'S SVENSSON',TIME=?,MSGLEVEL=1          TRER
C     /*SD                    SU-TERMINALEN ARRHENIUSLABORATORIET        TRER
C     //JOBLIB DD DSN=SU.JLL304L.KEMI01,DISP=SHR                         TRER
C     //S1 EXEC PGM=TREOR,REGION=104K                                    TRER
C     //FT06F001 DD SYSOUT=A,DCB=(RECFM=UA,BLKSIZE=133)                  TRER
C     //FT05F001 DD *                                                    TRER
C         INPUT DATA CARDS TO PROGRAM TREOR                              TRER
C     /*                                                                 TRER
C                                                                        TRER
C                                                                        TRER
C                                                                        TRER
C                                                                        TRER
C     DATA CARDS                                                         TRER
C                                                                        TRER
C     CARD ONE. TITLE CARD                                               TRER
C               VERSION IBM 1800.   PUNCH MAX. 66 CHARACTERS IN COL. 1-6 TRER
C                   THE LAST CHARACTER MUST BE AN ASTERISK '*'           TRER
C                   MAX. 11 CHARACTERS, BLANKS INCLUDED, WILL BE PRINTED TRER
C                   ROW ON THE FIRST OUTPUT PAGE. (BIG SCALE OUTPUT)     TRER
C                   A SLASH DENOTES THAT YOU WANT THE FOLLOWING CHARACTE TRER
C                   BE PRINTED ON THE NEXT OUTPUT ROW.                   TRER
C                                                                        TRER
C                                                                        TRER
C               VERSION IBM 360/75  PUNCH ANY TEXT IN COL. 2-80          TRER
C                                                                        TRER
C     CARD SET TWO.      FORMAT(F15.6,10X,A4)    SQ IN F15.6 AND INTENSI TRER
C                        THE NORMAL CARD SET TWO IS THE BATCH OF SINE SQ TRER
C                        THETA CARDS OBTAINED BY PROGRAM PILT.           TRER
C                        PROGRAM PILT. REFERENCE. MALMROS,G. AND WERNER, TRER
C                        ACTA CHEM. SCAND. 27(1973)493-502               TRER
C                        IT IS POSSIBLE,HOWEVER,TO USE OTHER TYPES OF IN TRER
C                        DATA IN THE F15.6 FIELD. SEE PARAMETER 'CHOICE' TRER
C                        CARD SET THREE(BELOW).                          TRER
C                        THE INTENSITY INFORMATION IN THE A4 FIELD IS OP TRER
C                                                                        TRER
C         STOP CARD FOR CARD SET TWO IS A BLANK CARD (OR A NEGATIVE SQ)  TRER
C                                                                        TRER
C                                                                        TRER
C     CARD SET THREE.    GENERAL INSTRUCTIONS.                           TRER
C                                                                        TRER
C     ALL PARAMETERS IN CARD SET THREE HAVE PRESET VALUES.               TRER
C     A PRESET VALUE IS DENOTED 'NORMAL VALUE' BELOW.                    TRER
C     ANY 'NORMAL VALUE' MAY BE CHANGED IN THE FOLLOWING WAY:            TRER
C     PUNCH:   KEYWORD=VALUE,                                            TRER
C     1. THE KEYWORDS ARE LISTED BELOW                                   TRER
C     2. YOU MUST NOT FORGET =                                           TRER
C     3. THE VALUE MAY BE PUNCHED AS INTEGER OR REAL. (FREE FORMAT)      TRER
C     4. YOU MUST NOT FORGET ,                                           TRER
C                                                                        TRER
C     YOU MAY PUNCH IN ARBITRARY POSITIONS ON THE CARDS.                 TRER
C     ALL BLANKS ARE IRRELEVANT.                                         TRER
C     THE NUMBER OF CARDS IS ARBITRARY. YOU MAY PUNCH ONE OR MORE PARAME TRER
C     ON EACH CARD.                                                      TRER
C                                                                        TRER
C     CARD SET THREEE MUST END WITH THE KEYWORD    END*     (WITHOUT = E TRER
C                                                                        TRER
C     EXAMPLE 1.   NEXT LINE (EXCEPT C IN COL. 1) REPRESENTS A CARD SET  TRER
C         END*                                                           TRER
C     THIS IS A NORMAL FIRST RUN. (CUBIC,TETRAGONAL,HEXAGONAL AND ORTHOR TRER
C     SYMMETRIES ARE TRIED)                                              TRER
C                                                                        TRER
C     EXAMPLE 2. NEXT TWO LINES (NOT C IN COL. 1) IS A CARD SET THREE.   TRER
C     KS=0,THS=0,OS1=0,                                                  TRER
C     CEM=20.0 , V O L = 2000 , MONO=130,   END*                         TRER
C                                                                        TRER
C     THIS IS A TYPICAL MONOCLINIC TRIAL.                                TRER
C     NOTE THAT IT IS IRRELEVANT IF YOU PUNCH 'CEM=20.0' OR 'CEM=20' ETC TRER
C                                                                        TRER
C                                                                        TRER
C     K E Y W O R D    L I S T                                           TRER
C                                                                        TRER
C     KEYWORD. NORMAL    COMMENT.                                        TRER
C              VALUE.                                                    TRER
C                                                                        TRER
C                                                                        TRER
C     KH      =4         MAX H FOR CUBIC BASE LINE.                      TRER
C     KK      =4         MAX K FOR CUBIC BASE LINE.                      TRER
C     KL      =4         MAX L FOR CUBIC BASE LINE.                      TRER
C                                                                        TRER
C                        OBS. THE PROGRAM WILL ONLY GENERATE H GREATER T TRER
C                             EQ. TO K GREATER THAN OR EQ. TO L FOR THIS TRER
C                                                                        TRER
C     KS      =6         MAX H+K+L FOR THIS LINE.                        TRER
C                                                                        TRER
C                        OBS. IF KS=0 CUBIC TEST OMITTED.                TRER
C                                                                        TRER
C                        OBS. THE CUBIC BASE LINES ARE (1) AND (2).      TRER
C                                                                        TRER
C                        * * * * * * * * * * * * * * * * * * * * * * * * TRER
C                                                                        TRER
C     THH     =4         MAX H FOR TETRAGONAL AND HEXAGONAL BASE LINES.  TRER
C     THK     =4         MAX K FOR TETRAGONAL AND HEXAGONAL BASE LINES.  TRER
C     THL     =4         MAX L FOR TETRAGONAL AND HEXAGONAL BASE LINES.  TRER
C                                                                        TRER
C                        OBS. THE PROGRAM WILL ONLY GENERATE H GREATER T TRER
C                             EQ. TO K FOR THESE LINES.                  TRER
C                                                                        TRER
C     THS     =4         MAX H+K+L FOR THESE LINES.                      TRER
C                                                                        TRER
C                        OBS. IF THS=0 TETRAGONAL AND HEXAGONAL TESTS OM TRER
C                                                                        TRER
C                        OBS. THE TETRAGONAL AND HEXAGONAL BASE LINES    TRER
C                             ARE (1,2),(1,3) AND (2,3)                  TRER
C                                                                        TRER
C                        * * * * * * * * * * * * * * * * * * * * * * * * TRER
C                                                                        TRER
C     OH1     =2         MAX H FOR THE FIRST ORTHORHOMBIC BASE LINE.     TRER
C     OK1     =2         MAX K FOR THE FIRST ORTHORHOMBIC BASE LINE.     TRER
C     OL1     =2         MAX L FOR THE FIRST ORTHORHOMBIC BASE LINE.     TRER
C                                                                        TRER
C                        OBS. THE PROGRAM WILL ONLY GENERATE H GREATER T TRER
C                             EQ. TO K GREATER THAN OR EQ. TO L FOR THIS TRER
C                             THIS IS ALSO VALID IF THE 'SELECT' PARAMET TRER
C                             IS USED. (SEE BELOW)                       TRER
C                                                                        TRER
C     OS1     =3         MAX H+K+L FOR THIS LINE.                        TRER
C                                                                        TRER
C                        OBS. IF OS1=0 ORTHORHOMBIC TEST OMITTED.        TRER
C                                                                        TRER
C     OH2     =2         MAX H FOR THE SECOND ORTHORHOMBIC BASE LINE.    TRER
C     OK2     =2         MAX K FOR THE SECOND ORTHORHOMBIC BASE LINE.    TRER
C     OL2     =2         MAX L FOR THE SECOND ORTHORHOMBIC BASE LINE.    TRER
C     OS2     =3         MAX H+K+L FOR THIS LINE.                        TRER
C                                                                        TRER
C     OH3     =2         MAX H FOR THE THIRD ORTHORHOMBIC BASE LINE.     TRER
C     OK3     =2         MAX K FOR THE THIRD ORTHORHOMBIC BASE LINE.     TRER
C     OL3     =2         MAX L FOR THE THIRD ORTHORHOMBIC BASE LINE.     TRER
C     OS3     =4         MAX H+K+L FOR THIS LINE.                        TRER
C                        OBS. THE ORTHOROMBIC BASE LINES ARE             TRER
C                        (1,2,3) (1,2,4) (1,2,5) (1,3,4) AND (2,3,4)     TRER
C                                                                        TRER
C                        IF THE PARAMETER    SELECT=0                    TRER
C                        PARAMETER 'SELECT' SEE BELOW.                   TRER
C                                                                        TRER
C                        * * * * * * * * * * * * * * * * * * * * * * * * TRER
C                                                                        TRER
C     MH1     =2         MAX ABS(H) FOR THE FIRST MONOCLINIC BASE LINE.  TRER
C     MK1     =2         MAX K FOR THE FIRST MONOCLINIC BASE LINE.       TRER
C     ML1     =2         MAX L FOR THE FIRST MONOCLINIC BASE LINE.       TRER
C                                                                        TRER
C                        OBS. THE PROGRAM WILL ONLY GENERATE H GREATER T TRER
C                             EQ. TO L FOR THIS LINE.                    TRER
C                             THIS IS ALSO VALID IF THE 'SELECT' PARAMET TRER
C                             IS USED. (SEE BELOW)                       TRER
C                                                                        TRER
C     MS1     =2         MAX ABS(H)+K+L FOR THIS LINE.                   TRER
C                        THE NORMAL (AND FAST) WAY TO TEST ONE EXPECTED  TRER
C                        EDGE PARAMETER IS TO PUT IT IN AS Q NUMBER ONE  TRER
C                        SET TWO) AND SET MH1=1,MK1=1,ML1=0,MS1=1.       TRER
C                                                                        TRER
C     MH2     =2         MAX ABS(H) FOR THE SECOND MONOCLINIC BASE LINE. TRER
C     MK2     =2         MAX K FOR THE SECOND MONOCLINIC BASE LINE.      TRER
C     ML2     =2         MAX L FOR THE SECOND MONOCLINIC BASE LINE.      TRER
C     MS2     =3         MAX ABS(H)+K+L FOR THIS LINE.                   TRER
C                                                                        TRER
C     MH3     =2         MAX ABS(H) FOR THE THIRD MONOCLINIC BASE LINE.  TRER
C     MK3     =2         MAX K FOR THE THIRD MONOCLINIC BASE LINE.       TRER
C     ML3     =2         MAX L FOR THE THIRD MONOCLINIC BASE LINE.       TRER
C     MS3     =3         MAX ABS(H)+K+L FOR THIS LINE.                   TRER
C                                                                        TRER
C     MH4     =2         MAX ABS(H) FOR THE FOURTH MONOCLINIC BASE LINE. TRER
C     MK4     =2         MAX K FOR THE FOURTH MONOCLINIC BASE LINE.      TRER
C     ML4     =2         MAX L FOR THE FOURTH MONOCLINIC BASE LINE.      TRER
C     MS4     =4         MAX ABS(H)+K+L FOR THIS LINE.                   TRER
C                                                                        TRER
C                        OBS. THE MONOCLINIC BASE LINES ARE              TRER
C                        (1,2,3,4) (1,2,3,5) AND (1,2,4,5)               TRER
C                        IF THE PARAMETER 'SELECT' IS LESS THAN 6        TRER
C                                                                        TRER
C                        PARAMETER 'SELECT' SEE BELOW.                   TRER
C                                                                        TRER
C                                                                        TRER
C     MONOSET =0         THIS PARAMETER MAKES IT POSSIBLE TO USE MORE TH TRER
C                        SETS OF BASE LINES IN THE MONOCLINIC TRIALS.    TRER
C                        IF MONOSET IS:                                  TRER
C                        GREATER THAN 3 THE BASE LINE SET (1,3,4,5) WILL TRER
C                        GREATER THAN 4 THE BASE LINE SET (1,2,3,6) WILL TRER
C                        GREATER THAN 5 THE BASE LINE SET (2,3,4,5) WILL TRER
C                        GREATER THAN 6 THE BASE LINE SET (1,2,3,7) WILL TRER
C                        THUS MAX 7 BASE LINE SETS CAN BE USED.          TRER
C                                                                        TRER
C     MONOGAM=1          THE BEST 5 TRIAL PARAMETER SETS STORED          TRER
C                        (SEE PARAMETER 'IQ') FOR EACH BASE LINE SET WIL TRER
C                        REFINED BEFORE NEXT BASE LINE SET IS TRIED.     TRER
C                                                                        TRER
C                        IF MONOGAM=0 ALL BASE LINE SETS ARE TRIED BEFOR TRER
C                        ANY REFINEMENT IS PERFORMED.                    TRER
C                                                                        TRER
C                        THE PARAMETER IS ONLY USED IN THE MONOCLINIC TE TRER
C                                                                        TRER
C                        IT IS RECOMMENDED TO USE MONOGAM=1 BECAUSE A RE TRER
C                        CELL PARAMETER SET IS ALWAYS TESTED FOR THE STO TRER
C                        LIMITS 'MERIT' AND 'NIX'. THUS COMPUTER TIME CA TRER
C                        SAVED.                                          TRER
C                                                                        TRER
C     MONO    =0         MAX BETA ANGLE ALLOWED IN A MONOCLINIC CELL.    TRER
C                        OBS. NO MONOCLINIC TEST IF MONO=0               TRER
C                                                                        TRER
C                        * * * * * * * * * * * * * * * * * * * * * * * * TRER
C                                                                        TRER
C     USE     =19       -OR EQ. TO THE NUMBER OF INPUT LINES IF THERE AR TRER
C                        THAN 19 LINES,                                  TRER
C                       -OR EQ. TO THE NUMBER OF LINES WITH SINE SQUARE( TRER
C                        LESS THAN 0.327                                 TRER
C                       -'USE' IS THE NUMBER OF LINES USED IN THE TRIAL- TRER
C                        PART OF THE CALCULATIONS.                       TRER
C                                                                        TRER
C                        OBS. MAX USE=20                                 TRER
C                                                                        TRER
C                        OBS. IF YOU WANT TO CHANGE THIS PARAMETER YOU S TRER
C                             ALSO CHANGE THE PARAMETER IQ.              TRER
C                                                                        TRER
C     IQ      =USE-3     THE NUMBER OF INDEXABLE LINES REQUIRED IN THE T TRER
C                        INDEXING PROCEDURE IF THE CELL SHOULD BE STORED TRER
C                        EV. LEAST-SQUARES REFINEMENT.                   TRER
C                        THESE RECIPROCAL CELL PARAMETERS ARE PRINTED IF TRER
C                        PARAMETER   LIST=1                              TRER
C                                                                        TRER
C     LIST    =0         SEE. ABOVE.                                     TRER
C                                                                        TRER
C     SELECT  =0         IF 'SELECT' IS NON ZERO THE ORTHORHOMBIC BASE L TRER
C                        (SELECT,1,2) (SELECT,1,3) AND (SELECT,2,3)      TRER
C                                                                        TRER
C                        IF 'SELECT' IS GREATER THAN 5 THE MONOCLINIC BA TRER
C                        ARE (SELECT,1,2,3) (SELECT,1,2,4) AND (SELECT,1 TRER
C                                                                        TRER
C     MERIT   =9         FIGURE OF MERIT REQUIRED AS STOP LIMIT.         TRER
C                        THE FIGURE OF MERIT IS FOR AN ORTHORHOMBIC CELL TRER
C                        BY DE WOLFF,P.M., J.APPL.CRYST. 1(1968)108-113. TRER
C                        ( FOR THE CUBIC ,TETRAGONAL AND HEXAGONAL SYMME TRER
C                        ARE THE DIFFERENT QUADRATIC FORMS AS GIVEN IN   TRER
C                        INT. TABL. X-RAY CRYST.(1968) VOL.2 P.109-145 U TRER
C                        THE CALCULATION OF THE NUMBER OF THEORETICAL LI TRER
C                                                                        TRER
C                        OBS. THE FIGURE OF MERIT CALCULATIONS ARE NOT S TRER
C                        VALID UNLESS ALL TWENTY FIRST LINES ARE INDEXED TRER
C                                                                        TRER
C                                                                        TRER
C     NIX     =1         IF A CELL AFTER LEAST SQUARES REFINEMENT HAS A  TRER
C                        OF MERIT EQ. TO OR GREATER THAN THE PARAMETER   TRER
C                        AND THE NUMBER OF NOT INDEXABLE LINES AMONG THE TRER
C                        FIRST LINES ARE LESS THAN OR EQ. TO 'NIX' THE   TRER
C                        CALCULATIONS ARE STOPPED.                       TRER
C                                                                        TRER
C                        OBS. OTHERWISE THE CALCULATIONS WILL END WITH A TRER
C                             DIFFERENCE ANALYSIS (PROGRAM I1.  WERNER,  TRER
C                             Z.KRISTALLOGR. 120(1964)375-378)           TRER
C                                                                        TRER
C     WAVE    =1.54051   WAVE LENGTH. (IN ANGSTROEM)                     TRER
C                                                                        TRER
C     VOL     =4500      MAX CELL VOLUME (IN ANGSTROEM**3)               TRER
C                                                                        TRER
C     CEM     =30        MAX CELL EDGE (IN ANGSTROEM)                    TRER
C                        THE COMPUTING TIME IS STRONGLY DEPENDENT ON THE TRER
C                        VOL AND CEM PARAMETERS. THEREFORE,IF POSSIBLE   TRER
C                        PUT IN SMALLER VALUES (AT LEAST IN MONOCLINIC T TRER
C                                                                        TRER
C     D1      =0.0002    DEFINED AS FOR PROGRAM PIRUM.                   TRER
C                        (WERNER P.E. ARKIV KEMI 31(1969)513-516)        TRER
C                                                                        TRER
C     SSQTL   =0.05      DEFINED AS FOR PROGRAM PIRUM.                   TRER
C                                                                        TRER
C     D2      =0.0004    DEFINED AS FOR PROGRAM PIRUM.                   TRER
C                                                                        TRER
C                        OBS. THE PARAMETERS D1,SSQTL AND D2 ARE USED IN TRER
C                             TRIAL INDEXING PART AS WELL AS THE LEAST-S TRER
C                             REFINEMENTS.                               TRER
C                        OBS. 'D1,SSQTL AND D2' ARE DEPENDENT ON 'WAVE'  TRER
C                        OBS. THE PARAMETER D2 IS ALSO USED IN THE DIFFE TRER
C                             ANALYSIS.                                  TRER
C                                                                        TRER
C     CHOICE  =0         INDICATOR DEFINING 'SQ' ON CARD SET TWO.        TRER
C                        CHOICE=0   SQ=SINE SQUARE THETA                 TRER
C                              =1   SQ=1/(D*D)    ('D'-SPACING IN ANGSTR TRER
C                              =2   SQ=THETA      ('THETA'=BRAGG ANGLE I TRER
C                              =3   SQ=2*THETA                           TRER
C                              =4   SQ=D                                 TRER
C                        OBS. IF 'CHOICE' IS NON ZERO IT IS ALWAYS POSSI TRER
C                             USE WAVE=1.54051 (THE NORMAL VALUE)        TRER
C                                                                        TRER
C     DENS    =0         DENSITY NOT USED.                               TRER
C                        IF ONLY AN INTEGRAL NUMBER OF MOLECULES IN THE  TRER
C                        CELL IS ACCEPTED THE PARAMETERS DENS,EDENS AND  TRER
C                        MAY BE USED.      (ON YOUR OWN RESPONSIBILITY)  TRER
C                        DENS EQ. DENSITY IN GRAM PER CM**3              TRER
C                                                                        TRER
C     EDENS   =0         NOT USED UNLESS DENS EQ. NON ZERO.              TRER
C                        EDENS EQ. MAX. DEVIATION IN THE PARAMETAR DENS. TRER
C                        OBS. DENS AND EDENS ARE USED IN TRIAL CALCULATI TRER
C                        I.E. THEY ARE USED IN TESTS ON NON REFINED UNIT TRER
C                        IT IS THEREFORE RECOMMENDED TO USE AN EDENS WHI TRER
C                        THE EXPECTED MAX. DEVIATION IN DENS PLUS 5-10 P TRER
C                        OF DENS. OBS. THE CHOICE OF EDENS SHOULD BE DEP TRER
C                        ON THE QUALITY OF YOUR DIFFRACTION DATA.        TRER
C                                                                        TRER
C     MOLW    =0         NOT USED UNLESS DENS ( AND EDENS ) EQ. NON ZERO TRER
C                        MOL. WEIGHT IN A.U. (OBS CRYSTAL WATER INCLUDED TRER
C                                                                        TRER
C                        THE PARAMETERS DENS,EDENS AND MOLW (IF KNOWN) M TRER
C                        USED IN MONOCLINIC TESTS IN ORDER TO REDUCE THE TRER
C                        COMPUTER TIME NEEDED. IT IS NOT RECOMMENDED TO  TRER
C                        THESE PARAMETERS FOR ORTHORHOMBIC AND HIGHER SY TRER
C                                                                        TRER
C                                                                        TRER
C     CONTINUE=0         ONE CALCULATION.                                TRER
C                        IF CONTINUE=1 A NEW TITLE CARD ETC. MUST FOLLOW TRER
C                        KEYWORD 'END*'                                  TRER
C                                                                        TRER
C     END*               THIS KEYWORD DENOTES THE END OF THE PARAMETER L TRER
C                        (I.E. END OF CARD SET THREE)                    TRER
C                                                                        TRER
CDC   PROGRAM TREOR(INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT)               TRER
C                                                                        TRER
      COMMON DEN,EDEN,RMOLV                                              TRER
      COMMON T1(100),TAGUT(100),N1,D1,SSQTL,D2,WAVE,IHM,IKM,ILM,ISYM,INR TRER
     1,ISUB,A11,A22,A33,A13,A12,A23,LIN(10),REV(10)                      TRER
     2,IGOT,IS1,IS2,IS3,IS4,IA,IB,IQ,IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3 TRER
     3,SQ1,SQ2,SQ3,X,Y,Z,IC(20),ISQM,KOTA(30),RO(4,30),ID,IIN,IOUT       TRER
      COMMON NH1,NK1,NL1,NS1,NH2,NK2,NL2,NS2,NH3,NK3,NL3,NS3,IUTSK,IMER, TRER
     1INIX,IOMIT,ISC,KLART,VOL,VTEST,XL,YL,IT20,IT40,CEM                 TRER
     2,KHA,KKA,KLA,KSA,KHB,KKB,KLB,KSB,MONO,MH1,MK1,ML1,MH2,MK2,ML2,MH3, TRER
     3MK3,ML3,MS1,MS2,MS3,MH4,MK4,ML4,MS4,UL,LGO,MG,MS,MRA,MRB,NU        TRER
     4,IDUMMY(7)                                                         TRER
C- DEC-10  EXTRA 7 DUMMY VARIABLES ADDED TO COMMON TO MAKE SAME SIZE     TRER
C- DEC-10  AS IN SUBROUTINE TREOD ('501')                                TRER
      IIN=5                                                              TRER
      IOUT=6                                                             TRER
    6 CALL PWINL                                                         TRER
    2 CALL TREOB                                                         TRER
    3 CALL TREOC(IGOE)                                                   TRER
      GO TO(1,2,4),IGOE                                                  TRER
    1 CALL TREOD                                                         TRER
      GO TO 3                                                            TRER
    4 IF(LGO)5,5,6                                                       TRER
    5 STOP                                                               TRER
      END                                                                TRER
C                                                                        TRER
C/TREOR JOB (JLL304,6,3,5),'S SALOME',TIME=2,MSGLEVEL=1                  TRER
C/TREOR JOB (JLL304,6,3,5),'S SALOME',TIME=2,MSGLEVEL=1                  TRER
C*SD                          SU-TERMINALEN ARRHENIUSLABORATORIET        TRER
C/* THIS FIRST SUBROUTINE ATNC IS COMPILED IN FORTRAN G BECAUSE OF AN ER TRER
C/* IN OUR FORTRAN H COMPILER , IT CANT HANDLE THE ROUTINE, NORMALLY THE TRER
C/* PROGRAM SHOULD BE COMPILED WITH A FORTRAN H COMPILER OR A SIMILAR    TRER
C/* OPTIMIZING COMPILER.                                                 TRER
C/ATNC EXEC FORTGC                                                       TRER
C/FORT.SYSIN  DD *                                                       TRER
C/FORT.SYSIN  DD *                                                       TRER
C                                                                        TRER
      SUBROUTINE ATNC(IT,RT,LT,IQ,IVAL)                                  TRER
C-----ROUTINE FOR CONVERSION OF NUMERIC VALUES IN AN ALPHANUMERIC FIELD  TRER
C-----FROM ALPHAMERIC REPR. TO NUMERIC REPR.                             TRER
C-----VERSION 1975.07.14                                                 TRER
C-----WRITTEN BY STEFAN SALOME,UNIV. OF STOCKHOLM,INST. FOR STRUCTURAL C TRER
                                                                         TRER
      DIMENSION IVAL(1)                                                  TRER
      DATA IPKT,MINUS,IPACE/'.','-',' '/                                 TRER
                                                                         TRER
      N=-1                                                               TRER
      NT=0                                                               TRER
      INTG=0                                                             TRER
      RNTG=0.0                                                           TRER
      IMN=-1                                                             TRER
      RMN=-1.0                                                           TRER
                                                                         TRER
C-----CHECK IF NUMBER IS NEGATIVE                                        TRER
      DO 2 I=1,LT                                                        TRER
      IF(IVAL(I)-MINUS)2,1,2                                             TRER
    1 NT=1                                                               TRER
      IVAL(I)=IPACE                                                      TRER
      GO TO 3                                                            TRER
    2 CONTINUE                                                           TRER
                                                                         TRER
C-----CHECK IF NUBMBER IS REAL                                           TRER
    3 DO 4 I=1,LT                                                        TRER
      IF(IVAL(I)-IPKT)4,5,4                                              TRER
    4 CONTINUE                                                           TRER
                                                                         TRER
C-----INTEGER VALUE                                                      TRER
      IQ=1                                                               TRER
      IX=LT+1                                                            TRER
                                                                         TRER
C-----COMPUTE NUMERIC VALUE                                              TRER
      DO 6 I=1,LT                                                        TRER
      IX=IX-1                                                            TRER
      IF(IVAL(IX)-IPACE)7,6,7                                            TRER
    7 N=N+1                                                              TRER
      IZ=10**N                                                           TRER
      CALL ATNCS(IVAL(IX),NIX,IER)                                       TRER
      IF(IER)800,800,801                                                 TRER
  800 INTG=INTG+IZ*NIX                                                   TRER
    6 CONTINUE                                                           TRER
      IT=INTG                                                            TRER
      IF(NT)900,900,10                                                   TRER
   10 IT=IT*IMN                                                          TRER
  900 RETURN                                                             TRER
                                                                         TRER
C-----REAL VALUE                                                         TRER
    5 IQ=2                                                               TRER
      IPOS=I-1                                                           TRER
      J=I                                                                TRER
                                                                         TRER
C-----COMPUTE NUMERIC VALUE                                              TRER
      DO 11 I=1,IPOS                                                     TRER
      J=J-1                                                              TRER
      IF(IVAL(J)-IPACE)12,11,12                                          TRER
   12 N=N+1                                                              TRER
      RZ=10.0**N                                                         TRER
      CALL ATNCS(IVAL(J),NIX,IER)                                        TRER
      IF(IER)802,802,801                                                 TRER
  802 RNTG=RNTG+RZ*FLOAT(NIX)                                            TRER
   11 CONTINUE                                                           TRER
      RN1=RNTG                                                           TRER
                                                                         TRER
      RN2=0.0                                                            TRER
      IPOS=IPOS+2                                                        TRER
      RZ=1.0                                                             TRER
      DO 15 I=IPOS,LT                                                    TRER
      IF(IVAL(I)-IPACE)16,15,16                                          TRER
   16 RZ=RZ*10.0                                                         TRER
      CALL ATNCS(IVAL(I),NIX,IER)                                        TRER
      IF(IER)803,803,801                                                 TRER
  803 RN2=RN2+FLOAT(NIX)/RZ                                              TRER
   15 CONTINUE                                                           TRER
      RT=RN1+RN2                                                         TRER
      IF(NT)900,900,17                                                   TRER
   17 RT=RT*RMN                                                          TRER
      GO TO 900                                                          TRER
  801 IQ=3                                                               TRER
      GO TO 900                                                          TRER
      END                                                                TRER
      SUBROUTINE ATNCS(J,K,L)                                            TRER
C-----THIS SUBROUTINE IS USED BY SUBROUTINE ATNC                         TRER
      DIMENSION ICH(10)                                                  TRER
      DATA ICH/'0','1','2','3','4','5','6','7','8','9'/                  TRER
      L=0                                                                TRER
      DO 1 I=1,10                                                        TRER
      IF(J-ICH(I))1,2,1                                                  TRER
    1 CONTINUE                                                           TRER
      L=1                                                                TRER
      RETURN                                                             TRER
    2 K=I-1                                                              TRER
      RETURN                                                             TRER
      END                                                                TRER
      SUBROUTINE FFCCR(IFILD,NFILD,RFILD,IR,IER,IIN)                     TRER
C-----FREE FORMAT CONTROL CARD READER, LOADS NUMERIC VALUES FROM CARD IN TRER
C-----MODE OF KEYWORD=NUMERIC VALUE, ETC.                                TRER
C-----VERSION 1974.02.14                                                 TRER
C-----WRITTEN BY STEFAN SALOME,UNIV. OF STOCKHOLM,DEPT. OF STRUCTURAL CH TRER
      DIMENSION ICARD(80),KEY(10),        NUM(20),KEYNU(31),             TRER
     -          IFILD(1),NFILD(1),RFILD(1)                               TRER
      DATA ISPAC,ICOM,ISLA,ILIK,IAST,IPKT/' ',',','/','=','*','.'/       TRER
      DATA I1,I2,I3/'E','N','D'/                                         TRER
      KEYLE=10                                                           TRER
      NUMLE=15                                                           TRER
      NUKE=NUMLE+KEYLE+1                                                 TRER
      JSCOL=80                                                           TRER
      IER=0                                                              TRER
      JSW=0                                                              TRER
    4 NPOS=0                                                             TRER
      READ(IIN,200)ICARD                                                 TRER
  200 FORMAT(80A1)                                                       TRER
      IF(JSW)900,900,52                                                  TRER
  900 I=0                                                                TRER
   52 N=NPOS                                                             TRER
      JSW=0                                                              TRER
    2 N=N+1                                                              TRER
      IF(N-JSCOL)3,3,40                                                  TRER
   40 JSW=1                                                              TRER
      GO TO 4                                                            TRER
    3 IX=ICARD(N)                                                        TRER
      IF(IX-ISPAC)1,2,1                                                  TRER
    1 IF(IX-ICOM)5,6,5                                                   TRER
    5 IF(IX-IAST)50,6,50                                                 TRER
   50 I=I+1                                                              TRER
      IF(I-NUKE)7,7,8                                                    TRER
    8 IER=1                                                              TRER
      GO TO 20                                                           TRER
    7 KEYNU(I)=IX                                                        TRER
      GO TO 2                                                            TRER
    6 NPOS=N                                                             TRER
      IPOS=I                                                             TRER
      DO 600 I=1,NUMLE                                                   TRER
  600 NUM(I)=ISPAC                                                       TRER
      DO 601 I=1,KEYLE                                                   TRER
  601 KEY(I)=ISPAC                                                       TRER
      ISW=0                                                              TRER
      J=0                                                                TRER
      I=0                                                                TRER
    9 I=I+1                                                              TRER
      IF(I-IPOS)10,10,11                                                 TRER
   10 IX=KEYNU(I)                                                        TRER
      IF(ISW)14,14,15                                                    TRER
   14 IF(IX-ILIK)12,13,12                                                TRER-1
   12 IF(I-KEYLE)120,120,8                                               TRER
  120 KEY(I)=IX                                                          TRER
      GO TO 9                                                            TRER
   13 ISW=1                                                              TRER
      IPES=I-1                                                           TRER
      GO TO 9                                                            TRER
   15 J=J+1                                                              TRER
      IF(J-NUMLE)400,400,8                                               TRER
  400 NUM(J)=IX                                                          TRER
      GO TO 9                                                            TRER
   11 IF(ICARD(NPOS)-IAST)17,111,17                                      TRER
  111 IF(KEY(1)-I1)17,18,17                                              TRER
   18 IF(KEY(2)-I2)17,19,17                                              TRER
   19 IF(KEY(3)-I3)17,20,17                                              TRER
   20 I=0                                                                TRER
   24 I=I+1                                                              TRER
      IX=IFILD(I)                                                        TRER
      IF(IX-IPKT)21,22,21                                                TRER
   21 IF(IX-ISLA)24,23,24                                                TRER
   23 IFILD(I)=IAST                                                      TRER
      GO TO 24                                                           TRER
   22 RETURN                                                             TRER
   17 NPIS=0                                                             TRER
      NUMLA=J                                                            TRER
      IA=0                                                               TRER
   25 N=NPIS                                                             TRER
   26 N=N+1                                                              TRER
      IX=IFILD(N)                                                        TRER
      IF(IX-IPKT)261,32,261                                              TRER
  261 IF(IX-IAST)260,27,260                                              TRER
  260 IF(IX-ISLA)26,270,26                                               TRER
  270 IA=IA+1                                                            TRER
      GO TO 26                                                           TRER
   27 NPUS=N+1                                                           TRER
      IA=IA+1                                                            TRER
   31 N=N+1                                                              TRER
      IX=IFILD(N)                                                        TRER
      IF(IX-IAST)28,29,28                                                TRER
   28 IF(IX-ISLA)30,29,30                                                TRER
   30 IF(IX-IPKT)31,32,31                                                TRER
   32 IER=2                                                              TRER
      GO TO 20                                                           TRER
   29 NPAS=N-1                                                           TRER
      IA=IA+1                                                            TRER
      NPIS=N-1                                                           TRER
      IF(((NPAS-NPUS)+1)-IPES)250,33,250                                 TRER
   33 N=0                                                                TRER
      DO 34 I=NPUS,NPAS                                                  TRER
      N=N+1                                                              TRER
      IF(IFILD(I)-KEY(N))250,34,250                                      TRER
   34 CONTINUE                                                           TRER
      IA=IA-1                                                            TRER
      GO TO 311                                                          TRER
  250 IA=IA-1                                                            TRER
      GO TO 25                                                           TRER
  311 N=NPUS-1                                                           TRER
      IFILD(N)=ISLA                                                      TRER
      CALL ATNC(IT,RT,NUMLE,IQ,NUM)                                      TRER
      IF(IQ-2)326,327,328                                                TRER
  328 IER=3                                                              TRER
      GO TO 20                                                           TRER
  327 IF(IA-IR)320,321,321                                               TRER
  320 NFILD(IA)=IFIX(RT)                                                 TRER
      IER=4                                                              TRER
      GO TO 900                                                          TRER
  321 IA=(IA-IR)+1                                                       TRER
      RFILD(IA)=RT                                                       TRER
      GO TO 900                                                          TRER
  326 IF(IA-IR)322,323,323                                               TRER
  323 IA=(IA-IR)+1                                                       TRER
      RFILD(IA)=FLOAT(IT)                                                TRER
      IER=5                                                              TRER
      GO TO 900                                                          TRER
  322 NFILD(IA)=IT                                                       TRER
      GO TO 900                                                          TRER
      END                                                                TRER
      SUBROUTINE PWINL                                                   TRER
      DIMENSION INTG(51),RNTG(9),KEY(276),KEA(61),KEB(63),KEC(16),       TRER
     -KED(55),KEE(38),KEF(43)                                            TRER
      COMMON DEN,EDEN,RMOLV                                              TRER
      COMMON T1(100),TAGUT(100),N1,D1,SSQTL,D2,WAVE,IHM,IKM,ILM,ISYM,INR TRER
     1,ISUB,A11,A22,A33,A13,A12,A23,LIN(10),REV(10)                      TRER
     2,IGOT,IS1,IS2,IS3,IS4,IA,IB,IQ,IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3 TRER
     3,SQ1,SQ2,SQ3,X,Y,Z,IC(20),ISQM,KOTA(30),RO(4,30),ID,IIN,IOUT       TRER
      COMMON NH1,NK1,NL1,NS1,NH2,NK2,NL2,NS2,NH3,NK3,NL3,NS3,IUTSK,IMER, TRER
     1INIX,IOMIT,ISC,KLART,VOL,VTEST,XL,YL,IT20,IT40,CEM                 TRER
     2,KHA,KKA,KLA,KSA,KHB,KKB,KLB,KSB,MONO,MH1,MK1,ML1,MH2,MK2,ML2,MH3, TRER
     3MK3,ML3,MS1,MS2,MS3,MH4,MK4,ML4,MS4,UL,LGO,MG,MS,MRA,MRB,NU        TRER
      EQUIVALENCE(KEY(1),KEA(1))                                         TRER-1
      EQUIVALENCE(KEY(62),KEB(1))                                        TRER-1
      EQUIVALENCE(KEY(125),KEC(1))                                       TRER-1
      EQUIVALENCE(KEY(141),KED(1))                                       TRER-1
      EQUIVALENCE(KEY(196),KEE(1))                                       TRER-1
      EQUIVALENCE(KEY(234),KEF(1))                                       TRER-1
      DATA KEA/'*','O','H','1','*','O','K','1','*','O','L','1','*','O',' TRER-2
     -S','1','*','O','H','2','*','O','K','2','*','O','L','2','*','O','S' TRER-2
     -,'2','*','O','H','3','*','O','K','3','*','O','L','3','*','O','S',' TRER-2
     -3','*','K','H','*','K','K','*','K','L','*','K','S','*'/            TRER-2
      DATA KEB/'T','H','H','*','T','H','K','*','T','H','L','*','T','H',' TRER-2
     -S','*','M','E','R','I','T','*','N','I','X','*','L','I','S','T',    TRER-2
     -'*','O','M','I','T','*','S','E','L','E','C','T','*','U','S','E','* TRER-2
     -','I','Q','*','M','O','N','O','*','M','H','1','*','M','K','1','*'/ TRER-2
      DATA KEC/                                                          TRER-2
     -'M','L','1','*','M','H','2','*','M','K','2','*','M','L','2','*'/   TRER-2
      DATA KED/'M','H','3','*','M','K','3','*','M','L','3','*','M','S',  TRER-2
     -'1','*','M','S','2','*','M','S','3','*','M','H','4','*','M','K',   TRER-2
     -'4','*','M','L','4','*','M','S','4','*','C','H','O','I','C','E',   TRER-2
     -'*','C','O','N','T','I','N','U','E'/                               TRER-2
      DATA KEE/                                                          TRER-2
     -'*','M','O','N','O','G','A','M','*','M','O','N','O','S','E','T','* TRER-2
     -','M','R','E','S','O','N','E','*','M','R','E','S','T','W','O',     TRER-2
     -'*','V','C','R','I','T'/                                           TRER-2
      DATA KEF/                                                          TRER-2
     -'*','D','1','*','S','S','Q','T','L','*','D','2','*','C','E','M',   TRER-2
     -'*','V','O','L','*','W','A','V','E','*','D','E','N','S',           TRER-2
     -'*','E','D','E','N','S','*','M','O','L','W','*','.'/               TRER-2
C                                                                        TRER
      ID=0                                                               TRER
      A11=0.0                                                            TRER
      A22=0.0                                                            TRER
      A33=0.0                                                            TRER
      A13=0.0                                                            TRER
      A12=0.0                                                            TRER
      A23=0.0                                                            TRER
      ISUB=0                                                             TRER
      INR=3                                                              TRER
      IGOT=0                                                             TRER
      IREAL=52                                                           TRER
C                                                                        TRER
      WRITE(IOUT,1111)                                                   TRER
 1111 FORMAT(40X,'TREOR VERSION (2) 75.09.01')                           TRER
      READ(IIN,1)                                                        TRER
    1 FORMAT(1X,79H N A M E                                              TRER
     1                   N A M E)                                        TRER
      WRITE(IOUT,1)                                                      TRER
C                                                                        TRER
      N1=0                                                               TRER
    2 N1=N1+1                                                            TRER
      READ(IIN,3)T1(N1),TAGUT(N1)                                        TRER
    3 FORMAT(F15.6,10X,A4)                                               TRER
      IF(T1(N1))400,400,401                                              TRER
  401 WRITE(IOUT,3)T1(N1),TAGUT(N1)                                      TRER
      GO TO 2                                                            TRER
C                                                                        TRER
C     IF THE KEYWORD SYSTEM CAN NOT BE USED ON A PARTICULAR COMPUTER     TRER
C     ALL STEERING PARAMETERS CAN BE READ WITH ORDINARY FORMATTED READ.  TRER
C     IN THAT CASE, REMOVE SUBROUTINES FFCCR,ATNC AND ATNCS              TRER
C     READ IN THE PARAMETERS IN SECTION KEYOUT USING NORMAL FORTRAN      TRER
C     FORMATTED CARD INPUT, THESE PARAMETERS CORRESPOND ONE TO ONE TO TH TRER
C     KEYWORDS IN SECTION KEYIN                                          TRER
C                                                                        TRER
C-----SECTION KEYIN                                                      TRER
  400 N1=N1-1                                                            TRER
      INTG(1)=2                                                          TRER
      INTG(2)=2                                                          TRER
      INTG(3)=2                                                          TRER
      INTG(4)=3                                                          TRER
      INTG(5)=2                                                          TRER
      INTG(6)=2                                                          TRER
      INTG(7)=2                                                          TRER
      INTG(8)=3                                                          TRER
      INTG(9)=2                                                          TRER
      INTG(10)=2                                                         TRER
      INTG(11)=2                                                         TRER
      INTG(12)=4                                                         TRER
      INTG(13)=4                                                         TRER
      INTG(14)=4                                                         TRER
      INTG(15)=4                                                         TRER
      INTG(16)=6                                                         TRER
      INTG(17)=4                                                         TRER
      INTG(18)=4                                                         TRER
      INTG(19)=4                                                         TRER
      INTG(20)=4                                                         TRER
      INTG(21)=9                                                         TRER
      INTG(22)=1                                                         TRER
      INTG(23)=0                                                         TRER
      INTG(24)=0                                                         TRER
      INTG(25)=0                                                         TRER
      IF(N1-19)301,302,302                                               TRER
  301 INTG(26)=N1                                                        TRER
      GO TO 303                                                          TRER
  302 INTG(26)=19                                                        TRER
  303 INTG(27)=INTG(26)-3                                                TRER
      INTG(28)=0                                                         TRER
      INTG(29)=2                                                         TRER
      INTG(30)=2                                                         TRER
      INTG(31)=2                                                         TRER
      INTG(32)=2                                                         TRER
      INTG(33)=2                                                         TRER
      INTG(34)=2                                                         TRER
      INTG(35)=2                                                         TRER
      INTG(36)=2                                                         TRER
      INTG(37)=2                                                         TRER
      INTG(38)=2                                                         TRER
      INTG(39)=3                                                         TRER
      INTG(40)=3                                                         TRER
      INTG(41)=2                                                         TRER
      INTG(42)=2                                                         TRER
      INTG(43)=2                                                         TRER
      INTG(44)=4                                                         TRER
      INTG(45)=0                                                         TRER
      INTG(46)=0                                                         TRER
      INTG(47)=1                                                         TRER
      INTG(48)=0                                                         TRER
      INTG(49)=0                                                         TRER
      INTG(50)=0                                                         TRER
      INTG(51)=0                                                         TRER
      RNTG(1)=0.0002                                                     TRER
      RNTG(2)=0.05                                                       TRER
      RNTG(3)=0.0004                                                     TRER
      RNTG(4)=30.0                                                       TRER
      RNTG(5)=(RNTG(4)**3)/6                                             TRER
      RNTG(6)=1.54051                                                    TRER
      RNTG(7)=0.0                                                        TRER
      RNTG(8)=0.2                                                        TRER
      RNTG(9)=0.0                                                        TRER
C                                                                        TRER
      CALL FFCCR(KEY,INTG,RNTG,IREAL,IERR,IIN)                           TRER
C                                                                        TRER
      IF(IERR)9001,9001,9002                                             TRER
 9002 IF(IERR-3)9000,9000,9001                                           TRER
 9000 WRITE(IOUT,300)                                                    TRER
  300 FORMAT(//,1X,'**ERROR** PROGRAM CONTROL CARD INVALID',/,1X,'PROPAB TRER
     -LY MISSING COMMA OR DELIMITER KEYWORD OR UNIDENTIFIED KEYWORD')    TRER
      CALL EXIT                                                          TRER
C-----END KEYIN                                                          TRER
C                                                                        TRER
C-----SECTION KEYOUT                                                     TRER
 9001 CONTINUE                                                           TRER
      NH1=INTG(1)                                                        TRER
      NK1=INTG(2)                                                        TRER
      NL1=INTG(3)                                                        TRER
      NS1=INTG(4)                                                        TRER
      NH2=INTG(5)                                                        TRER
      NK2=INTG(6)                                                        TRER
      NL2=INTG(7)                                                        TRER
      NS2=INTG(8)                                                        TRER
      NH3=INTG(9)                                                        TRER
      NK3=INTG(10)                                                       TRER
      NL3=INTG(11)                                                       TRER
      NS3=INTG(12)                                                       TRER
      KHB=INTG(13)                                                       TRER
      KKB=INTG(14)                                                       TRER
      KLB=INTG(15)                                                       TRER
      KSB=INTG(16)                                                       TRER
      KHA=INTG(17)                                                       TRER
      KKA=INTG(18)                                                       TRER
      KLA=INTG(19)                                                       TRER
      KSA=INTG(20)                                                       TRER
      IMER=INTG(21)                                                      TRER
      INIX=INTG(22)                                                      TRER
      IUTSK=INTG(23)                                                     TRER
      IOMIT=INTG(24)                                                     TRER
      ISC=INTG(25)                                                       TRER
      IB=INTG(26)                                                        TRER
      IQ=INTG(27)                                                        TRER
      MONO=INTG(28)                                                      TRER
      MH1=INTG(29)                                                       TRER
      MK1=INTG(30)                                                       TRER
      ML1=INTG(31)                                                       TRER
      MH2=INTG(32)                                                       TRER
      MK2=INTG(33)                                                       TRER
      ML2=INTG(34)                                                       TRER
      MH3=INTG(35)                                                       TRER
      MK3=INTG(36)                                                       TRER
      ML3=INTG(37)                                                       TRER
      MS1=INTG(38)                                                       TRER
      MS2=INTG(39)                                                       TRER
      MS3=INTG(40)                                                       TRER
      MH4=INTG(41)                                                       TRER
      MK4=INTG(42)                                                       TRER
      ML4=INTG(43)                                                       TRER
      MS4=INTG(44)                                                       TRER
      LGO=INTG(46)                                                       TRER
      MG=INTG(47)                                                        TRER
      MS=INTG(48)                                                        TRER
      MRA=INTG(49)                                                       TRER
      MRB=INTG(50)                                                       TRER
      IVCR=INTG(51)                                                      TRER
      D1=RNTG(1)                                                         TRER
      SSQTL=RNTG(2)                                                      TRER
      D2=RNTG(3)                                                         TRER
      CEM=RNTG(4)                                                        TRER
      VOL=RNTG(5)                                                        TRER
      WAVE=RNTG(6)                                                       TRER
      DEN=RNTG(7)                                                        TRER
      EDEN=RNTG(8)                                                       TRER
      RMOLV=RNTG(9)                                                      TRER
C-----END KEYOUT                                                         TRER
C                                                                        TRER
                                                                         TRER
      ULA=0.0174533*FLOAT(MONO)                                          TRER
      ULB=COS(ULA)                                                       TRER
C     4*(COS(BETA MAX))**2                                               TRER
      UL=4.0*ULB*ULB                                                     TRER
C     CHOICE=0  SQ(THETA), =1 1/D2, =2 THETA, =3 2THETA, =4 D            TRER
      ICHOI=INTG(45)+1                                                   TRER
C                                                                        TRER
      GO TO(101,102,103,104,105),ICHOI                                   TRER
  102 OMV=(WAVE*WAVE)/4.0                                                TRER
      DO 110 I=1,N1                                                      TRER
      T1(I)=OMV*T1(I)                                                    TRER
  110 CONTINUE                                                           TRER
      GO TO 101                                                          TRER
  103 OMV=0.01745329                                                     TRER
  112 DO 111 I=1,N1                                                      TRER
      T1(I)=SIN(OMV*T1(I))**2                                            TRER-3
  111 CONTINUE                                                           TRER
      GO TO 101                                                          TRER
  104 OMV=0.008726646                                                    TRER
      GO TO 112                                                          TRER
  105 OMV=(WAVE*WAVE)/4.0                                                TRER
      DO 113 I=1,N1                                                      TRER
      H=T1(I)                                                            TRER
      T1(I)=OMV/(H*H)                                                    TRER
  113 CONTINUE                                                           TRER
C                                                                        TRER
  101 IF(IUTSK) 40,42,40                                                 TRER
   40 WRITE(IOUT,41) IQ                                                  TRER
   41 FORMAT(28H PRINT ALL TRIALS WITH IQ GE,I5)                         TRER
   42 WRITE(IOUT,44)                                                     TRER
   44 FORMAT(12H STOP LIMITS)                                            TRER
      WRITE(IOUT,43) IMER,INIX                                           TRER
   43 FORMAT(26H FIGURE OF MERIT REQUIRED=,I5,31H MAX NUMBER OF UNINDEXE TRER
     1D LINES=,I5)                                                       TRER
      IF(IOMIT) 47,45,47                                                 TRER
   45 WRITE(IOUT,46)                                                     TRER
   46 FORMAT(52H CUBIC,TETRAGONAL,HEXAGONAL AND ORTHOROMBIC SYMMETRY)    TRER
      GO TO 49                                                           TRER
   47 WRITE(IOUT,48)                                                     TRER
   48 FORMAT(21H ORTHOROMBIC SYMMETRY)                                   TRER
   49 WRITE(IOUT,64) CEM,VOL,D1,SSQTL,D2,WAVE                            TRER
   64 FORMAT(15H MAX CELL EDGE=,F5.1,17H MAX CELL VOLUME=,F10.1,/,4H D1= TRER
     1,F10.6,7H SSQTL=,F10.6,4H D2=,F10.6,6H WAVE=,F10.6)                TRER
      IF(DEN-0.00001)201,201,200                                         TRER
  200 WRITE(IOUT,50)RMOLV,DEN,EDEN                                       TRER
   50 FORMAT(1X,'MOLAR WEIGHT=',F10.3,' DENSITY=',F10.3,' MAX. DENSITY D TRER
     *EVIATION=',F10.3)                                                  TRER
C                                                                        TRER
  201 IT20=100000.0*D1+0.5                                               TRER
      IT40=100000.0*D2+0.5                                               TRER
      XL=(WAVE*WAVE)/(4.0*CEM*CEM)                                       TRER
      YL=(4.0*XL)/3.0                                                    TRER
      VTEST=(WAVE**6)/(64.0*VOL*VOL)                                     TRER
      DO 71 I=1,IB                                                       TRER
      HES=T1(I)                                                          TRER
      IF(HES-0.327) 70,70,68                                             TRER
C                                                                        TRER
   68 WRITE(IOUT,69) IB                                                  TRER
   69 FORMAT(53H NUMBER OF LINES WITH SQ LESS THAN 0.327 NOT EQUAL TO,I5 TRER
     1)                                                                  TRER
      GO TO 76                                                           TRER
   70 IC(I)=HES*100000.0+0.5                                             TRER
   71 CONTINUE                                                           TRER
   76 IB=I-1                                                             TRER
      IQ=IB-3                                                            TRER
      WRITE(IOUT,39) IB,IQ                                               TRER
   39 FORMAT(22H NUMBER OF TEST LINES=,I5,13H IQ REQUIRED=,I5)           TRER
      ISQM=IC(IB)+60                                                     TRER
      IF(IOMIT) 73,72,73                                                 TRER
   72 ISYM=1                                                             TRER
      RETURN                                                             TRER
   73 ISYM=3                                                             TRER
      RETURN                                                             TRER
      END                                                                TRER
      SUBROUTINE EKVA(IH1,IK1,IL1,IH2,IK2,IL2,ISYM,ISOLV,SKVA,SKVB,X,Y,X TRER
     1L,YL)                                                              TRER
C     ISYM=1 KUB  ISYM=2 TETR  ISYM=4 HEXAG.                             TRER
      GO TO(1,2,3,4,3),ISYM                                              TRER
    1 IK=IH1*IH1+IK1*IK1+IL1*IL1                                         TRER
      R=FLOAT(IK)                                                        TRER
      X=SKVA/R                                                           TRER
      IF(X-XL)5,5,6                                                      TRER
    5 ISOLV=0                                                            TRER
      RETURN                                                             TRER
    6 ISOLV=1                                                            TRER
      RETURN                                                             TRER
    2 I11=IH1*IH1+IK1*IK1                                                TRER
      I21=IH2*IH2+IK2*IK2                                                TRER
   10 I12=IL1*IL1                                                        TRER
      I22=IL2*IL2                                                        TRER
      IDET=I11*I22-I21*I12                                               TRER
      IF(IDET)7,5,7                                                      TRER
    7 DET=FLOAT(IDET)                                                    TRER
      R11=FLOAT(I11)                                                     TRER
      R21=FLOAT(I21)                                                     TRER
      R12=FLOAT(I12)                                                     TRER
      R22=FLOAT(I22)                                                     TRER
      X=(SKVA*R22-R12*SKVB)/DET                                          TRER
      IF(X-XL)5,5,8                                                      TRER
    8 Y=(R11*SKVB-SKVA*R21)/DET                                          TRER
      IF(Y-YL)5,5,6                                                      TRER
    4 I11=IH1*(IH1+IK1)+IK1*IK1                                          TRER
      I21=IH2*(IH2+IK2)+IK2*IK2                                          TRER
      GO TO 10                                                           TRER
    3 STOP                                                               TRER
      END                                                                TRER
      SUBROUTINE LAGRA(K)                                                TRER
      COMMON DEN,EDEN,RMOLV                                              TRER
      COMMON T1(100),TAGUT(100),N1,D1,SSQTL,D2,WAVE,IHM,IKM,ILM,ISYM,INR TRER
     1,ISUB,A11,A22,A33,A13,A12,A23,LIN(10),REV(10)                      TRER
     2,IGOT,IS1,IS2,IS3,IS4,IA,IB,IQ,IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3 TRER
     3,SQ1,SQ2,SQ3,X,Y,Z,IC(20),ISQM,KOTA(30),RO(4,30),ID,IIN,IOUT       TRER
      COMMON NH1,NK1,NL1,NS1,NH2,NK2,NL2,NS2,NH3,NK3,NL3,NS3,IUTSK,IMER, TRER
     1INIX,IOMIT,ISC,KLART,VOL,VTEST,XL,YL,IT20,IT40,CEM                 TRER
     2,KHA,KKA,KLA,KSA,KHB,KKB,KLB,KSB,MONO,MH1,MK1,ML1,MH2,MK2,ML2,MH3, TRER
     3MK3,ML3,MS1,MS2,MS3,MH4,MK4,ML4,MS4,UL                             TRER
      GO TO(61,62,63,62),ISYM                                            TRER
   61 XA=X                                                               TRER
      YA=X                                                               TRER
      ZA=X                                                               TRER
      GO TO 30                                                           TRER
   62 XA=X                                                               TRER
      YA=Y                                                               TRER
      ZA=X                                                               TRER
      GO TO 30                                                           TRER
   63 IF(X-Y) 2,3,3                                                      TRER
    3 IF(X-Z) 5,4,4                                                      TRER
    5 XA=Z                                                               TRER
      YA=X                                                               TRER
   21 ZA=Y                                                               TRER
      GO TO 30                                                           TRER
    4 IF(Y-Z) 6,7,7                                                      TRER
    7 XA=X                                                               TRER
      YA=Y                                                               TRER
   22 ZA=Z                                                               TRER
      GO TO 30                                                           TRER
    6 XA=X                                                               TRER
      YA=Z                                                               TRER
      GO TO 21                                                           TRER
    2 IF(X-Z) 8,9,9                                                      TRER
    9 XA=Y                                                               TRER
      YA=X                                                               TRER
      GO TO 22                                                           TRER
    8 IF(Y-Z) 11,12,12                                                   TRER
   11 XA=Z                                                               TRER
      YA=Y                                                               TRER
   23 ZA=X                                                               TRER
      GO TO 30                                                           TRER
   12 XA=Y                                                               TRER
      YA=Z                                                               TRER
      GO TO 23                                                           TRER
   30 PV=XA*YA*ZA                                                        TRER
      IF(ID) 32,31,32                                                    TRER
   31 ID=ID+1                                                            TRER
   44 I=ID                                                               TRER
   47 RO(4,I)=PV                                                         TRER
      RO(1,I)=XA                                                         TRER
      RO(2,I)=YA                                                         TRER
      RO(3,I)=ZA                                                         TRER
      KOTA(I)=K                                                          TRER
      RETURN                                                             TRER
   32 DO 33 I=1,ID                                                       TRER
      IF(ABS(RO(1,I)-XA)-0.00005) 34,33,33                               TRER
   34 IF(ABS(RO(2,I)-YA)-0.00005) 35,33,33                               TRER
   35 IF(ABS(RO(3,I)-ZA)-0.00005) 36,33,33                               TRER
   33 CONTINUE                                                           TRER
      DO 40 I=1,ID                                                       TRER
      IF(KOTA(I)-K)42,41,40                                              TRER
   41 IF(RO(4,I)-PV) 42,40,40                                            TRER
   42 IF(I-5) 43,44,99                                                   TRER
   40 CONTINUE                                                           TRER
      IF(ID-5) 31,36,36                                                  TRER
   43 N=4                                                                TRER
      IF(ID-5) 60,49,49                                                  TRER
   60 ID=ID+1                                                            TRER
   49 M=N+1                                                              TRER
      KOTA(M)=KOTA(N)                                                    TRER
      DO 46 J=1,4                                                        TRER
      RO(J,M)=RO(J,N)                                                    TRER
   46 CONTINUE                                                           TRER
      IF(N-I) 99,47,48                                                   TRER
   48 N=N-1                                                              TRER
      GO TO 49                                                           TRER
   99 STOP                                                               TRER
   36 RETURN                                                             TRER-5
      END                                                                TRER
      SUBROUTINE GHKLA(MAXH,MAXK,MAXL,MAXS,MSEL,ISLUT,IH,IK,IL)          TRER
C     MSEL=0 H GE K GE L      MSEL EQ NON ZERO H GE K                    TRER
C     ISLUT=0 END OF GEN.     ISLUT=1 CONTINUE                           TRER
C     IH,IK,IL GE 0                                                      TRER
      ISLUT=1                                                            TRER
    1 IF(IH-MAXH)2,5,5                                                   TRER
    2 IH=IH+1                                                            TRER
      IF(IH-IK)1,3,3                                                     TRER
    3 ISUM=IH+IK+IL                                                      TRER
      IF(MAXS-ISUM)5,4,4                                                 TRER
    4 RETURN                                                             TRER
    5 IF(IK-MAXK)6,7,7                                                   TRER
    6 IK=IK+1                                                            TRER
      IH=IK                                                              TRER
      GO TO 3                                                            TRER
    7 IF(IL-MAXL)9,8,8                                                   TRER
    8 IH=0                                                               TRER
      IK=0                                                               TRER
      IL=0                                                               TRER
      ISLUT=0                                                            TRER
      RETURN                                                             TRER
    9 IL=IL+1                                                            TRER
      IF(MSEL)10,11,10                                                   TRER
   10 IH=0                                                               TRER
      IK=0                                                               TRER
      RETURN                                                             TRER
   11 IH=IL                                                              TRER
      IK=IL                                                              TRER
      GO TO 3                                                            TRER
      END                                                                TRER
      SUBROUTINE ORT(IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3,ISOLV,SKVA,SKVB TRER
     1,SKVC,X,Y,Z,IO1,IO2,XL)                                            TRER
      IF(IO1) 1,2,1                                                      TRER
    1 IO1=0                                                              TRER
      IHH1=IH1*IH1                                                       TRER
      IKK1=IK1*IK1                                                       TRER
      ILL1=IL1*IL1                                                       TRER
      RHH1=FLOAT(IHH1)                                                   TRER
      RKK1=FLOAT(IKK1)                                                   TRER
      RLL1=FLOAT(ILL1)                                                   TRER
      HA=RKK1*SKVC                                                       TRER
      HB=RLL1*SKVB                                                       TRER
      HC=RLL1*SKVC                                                       TRER
      HD=RKK1*SKVB                                                       TRER
      HE=RHH1*SKVB                                                       TRER
      HF=RHH1*SKVC                                                       TRER
    2 IF(IO2) 3,4,3                                                      TRER
    3 IO2=0                                                              TRER
      IHH2=IH2*IH2                                                       TRER
      IKK2=IK2*IK2                                                       TRER
      ILL2=IL2*IL2                                                       TRER
      RHH2=FLOAT(IHH2)                                                   TRER
      RKK2=FLOAT(IKK2)                                                   TRER
      RLL2=FLOAT(ILL2)                                                   TRER
      LH3=IKK1*ILL2-ILL1*IKK2                                            TRER
      LK3=ILL1*IHH2-IHH1*ILL2                                            TRER
      LL3=IHH1*IKK2-IKK1*IHH2                                            TRER
      RA=SKVA*RKK2                                                       TRER
      RB=HA*RLL2                                                         TRER
      RC=HC*RKK2                                                         TRER
      RD=SKVA*RLL2                                                       TRER
      RE=HC*RHH2                                                         TRER
      RF=HF*RLL2                                                         TRER
      RG=SKVA*RHH2                                                       TRER
      RH=HF*RKK2                                                         TRER
      RI=HA*RHH2                                                         TRER
      SA=RB-RC                                                           TRER
      SB=HB-RD                                                           TRER
      SC=RA-HD                                                           TRER
      SD=RE-RF                                                           TRER
      SE=RD-HB                                                           TRER
      SF=HE-RG                                                           TRER
      SG=RH-RI                                                           TRER
      SH=HD-RA                                                           TRER
      SI=RG-HE                                                           TRER
    4 IHH3=IH3*IH3                                                       TRER
      IKK3=IK3*IK3                                                       TRER
      ILL3=IL3*IL3                                                       TRER
      IDET=IHH3*LH3+IKK3*LK3+ILL3*LL3                                    TRER
      IF(IDET) 6,5,6                                                     TRER
    5 ISOLV=0                                                            TRER
      RETURN                                                             TRER
    6 RHH3=FLOAT(IHH3)                                                   TRER
      RKK3=FLOAT(IKK3)                                                   TRER
      RLL3=FLOAT(ILL3)                                                   TRER
      RDET=FLOAT(IDET)                                                   TRER
      X=(SA+SB*RKK3+SC*RLL3)/RDET                                        TRER
      IF(X-XL) 5,5,7                                                     TRER
    7 Y=(SD+SE*RHH3+SF*RLL3)/RDET                                        TRER
      IF(Y-XL) 5,5,8                                                     TRER
    8 Z=(SG+SH*RHH3+SI*RKK3)/RDET                                        TRER
      IF(Z-XL) 5,5,9                                                     TRER
    9 ISOLV=1                                                            TRER
      RETURN                                                             TRER
      END                                                                TRER
      SUBROUTINE ORTAL(T1,X,Y,Z,N1,IB,IQ,ISQM,K,IC,IT20,IT40)            TRER
      DIMENSION T1(1),IC(1),KST(30)                                      TRER
      NX=100000.0*X+0.5                                                  TRER
      NY=100000.0*Y+0.5                                                  TRER
      NZ=100000.0*Z+0.5                                                  TRER
      IDH=ISQM/NX                                                        TRER
      IDK=ISQM/NY                                                        TRER
      IDL=ISQM/NZ                                                        TRER
      DO 8 I=1,IB                                                        TRER
      KST(I)=0                                                           TRER
    8 CONTINUE                                                           TRER
      IH=0                                                               TRER
      IK=0                                                               TRER
      IL=0                                                               TRER
      IHA=0                                                              TRER
      IHB=0                                                              TRER
      IHC=0                                                              TRER
      IHD=0                                                              TRER
      IHH=0                                                              TRER
      IKK=0                                                              TRER
      ILL=0                                                              TRER
C     GENERATE HKL AND ISQC                                              TRER
   15 IF(IHH-IDH) 51,52,52                                               TRER
   51 IH=IH+1                                                            TRER
      IHH=IH*IH                                                          TRER
      GO TO 57                                                           TRER
   52 IH=0                                                               TRER
      IHH=0                                                              TRER
      IHA=0                                                              TRER
      IF(IKK-IDK) 53,54,54                                               TRER
   53 IK=IK+1                                                            TRER
      IKK=IK*IK                                                          TRER
      GO TO 56                                                           TRER
   54 IK=0                                                               TRER
      IKK=0                                                              TRER
      IHB=0                                                              TRER
      IF(ILL-IDL) 55,30,30                                               TRER
   55 IL=IL+1                                                            TRER
      ILL=IL*IL                                                          TRER
      IHC=ILL*NZ                                                         TRER
      GO TO 60                                                           TRER
   56 IHB=IKK*NY                                                         TRER
   60 IHD=IHB+IHC                                                        TRER
      IHE=ISQM-IHD                                                       TRER
      IF(IHE) 54,59,59                                                   TRER
   57 IHA=IHH*NX                                                         TRER
   59 ISQC=IHA+IHD                                                       TRER
      IF(ISQM-ISQC) 52,58,58                                             TRER
   58 IF(ISQC-5000) 40,41,41                                             TRER
   40 IT=IT20                                                            TRER
      GO TO 42                                                           TRER
   41 IT=IT40                                                            TRER
   42 DO 19 I=1,IB                                                       TRER
      ISQO=IC(I)                                                         TRER
      ITQC=ISQO-ISQC                                                     TRER
      IF(IABS(ITQC)-IT) 20,20,65                                         TRER
   65 IF(ITQC) 19,19,15                                                  TRER
   20 KST(I)=1                                                           TRER
   19 CONTINUE                                                           TRER
      GO TO 15                                                           TRER
   30 K=0                                                                TRER
      DO 31 I=1,IB                                                       TRER
      K=K+KST(I)                                                         TRER
   31 CONTINUE                                                           TRER
      RETURN                                                             TRER
      END                                                                TRER
      SUBROUTINE GEHKL(MAXH,MAXK,MAXL,MAXS,MORMO,ISLUT,IH,IK,IL)         TRER
C     MORMO=1 ORTHO.    MORMO=2 MONOCLINIC. +-H                          TRER
C     ISLUT=0 END OF GEN. ISLUT=1 CONTINUE                               TRER
      ISLUT=1                                                            TRER
      GO TO(1,2),MORMO                                                   TRER
    1 IF(IH-MAXH) 3,4,4                                                  TRER
    3 IH=IH+1                                                            TRER
      ISUM=IH+IK+IL                                                      TRER
      IF(MAXS-ISUM) 4,5,5                                                TRER
    5 RETURN                                                             TRER
    4 IH=0                                                               TRER
      IF(IK-MAXK) 6,7,7                                                  TRER
    6 IK=IK+1                                                            TRER
      ISUM=IH+IK+IL                                                      TRER
      IF(MAXS-ISUM) 7,5,5                                                TRER
    7 IK=0                                                               TRER
      IF(IL-MAXL) 8,9,9                                                  TRER
    8 IL=IL+1                                                            TRER
      RETURN                                                             TRER
    9 IL=0                                                               TRER
      ISLUT=0                                                            TRER
      RETURN                                                             TRER
    2 IF(IH*IL) 10,1,11                                                  TRER
   11 IH=-IH                                                             TRER
      RETURN                                                             TRER
   10 IH=-IH                                                             TRER
      GO TO 1                                                            TRER
      END                                                                TRER
      SUBROUTINE TETAL(T1,X,Y,IB,IQ,ISQM,K,IC,ISYM,IT20,IT40)            TRER
      DIMENSION T1(1),IC(1),KST(30)                                      TRER
      NX=100000.0*X+0.5                                                  TRER
      IDH=ISQM/NX                                                        TRER
      DO 5 I=1,IB                                                        TRER
      KST(I)=0                                                           TRER
    5 CONTINUE                                                           TRER
      IH=0                                                               TRER
      IK=0                                                               TRER
      IL=0                                                               TRER
      IHH=0                                                              TRER
      IKK=0                                                              TRER
      ILL=0                                                              TRER
      IHA=0                                                              TRER
      GO TO(1,2,3,4),ISYM                                                TRER
    1 IF(IHH-IDH) 11,12,12                                               TRER
   11 IH=IH+1                                                            TRER
      IHH=IH*IH                                                          TRER
      GO TO 17                                                           TRER
   12 IF(IKK-IDH) 13,15,15                                               TRER
   13 IK=IK+1                                                            TRER
      IKK=IK*IK                                                          TRER
   14 IH=IK                                                              TRER
      IHH=IKK                                                            TRER
      IHA=IKK+ILL                                                        TRER
      GO TO 17                                                           TRER
   15 IF(ILL-IDH) 16,50,50                                               TRER
   16 IL=IL+1                                                            TRER
      ILL=IL*IL                                                          TRER
      IK=IL                                                              TRER
      IKK=ILL                                                            TRER
      GO TO 14                                                           TRER
   17 IHB=IHH+IHA                                                        TRER
      IF(IHB-IDH) 18,18,12                                               TRER
   18 ISQC=IHB*NX                                                        TRER
      IF(ISQM-ISQC) 12,19,19                                             TRER
   19 IF(ISQC-5000) 20,21,21                                             TRER
   20 IT=IT20                                                            TRER
      GO TO 22                                                           TRER
   21 IT=IT40                                                            TRER
   22 DO 23 I=1,IB                                                       TRER
      ISQO=IC(I)                                                         TRER
      ITQC=ISQO-ISQC                                                     TRER
      IF(IABS(ITQC)-IT) 24,24,25                                         TRER
   25 IF(ITQC) 23,23,70                                                  TRER
   24 KST(I)=1                                                           TRER
   23 CONTINUE                                                           TRER
   70 GO TO(1,30,3,30),ISYM                                              TRER
C     TETRAGONAL AND HEXAGONAL SYMMETRY                                  TRER
    2 ISM=0                                                              TRER
      GO TO 45                                                           TRER
    4 ISM=1                                                              TRER
   45 NY=100000.0*Y+0.5                                                  TRER
      IDL=ISQM/NY                                                        TRER
   30 IF(IHH-IDH) 31,32,32                                               TRER
   31 IH=IH+1                                                            TRER
      IHH=IH*IH                                                          TRER
   35 IF(ISM) 40,41,40                                                   TRER
   41 IHC=IHH+IKK                                                        TRER
      GO TO 42                                                           TRER
   40 IHC=IHH+IKK+IH*IK                                                  TRER
   42 IF(IHC-IDH) 38,38,32                                               TRER
   32 IF(IKK-IDH) 33,36,36                                               TRER
   33 IK=IK+1                                                            TRER
      IKK=IK*IK                                                          TRER
      IH=IK                                                              TRER
      IHH=IKK                                                            TRER
      GO TO 35                                                           TRER
   36 IF(ILL-IDL) 37,50,50                                               TRER
   37 IL=IL+1                                                            TRER
      ILL=IL*IL                                                          TRER
      IHA=ILL*NY                                                         TRER
      IH=0                                                               TRER
      IK=0                                                               TRER
      IKK=0                                                              TRER
      IHC=0                                                              TRER
   38 ISQC=IHC*NX+IHA                                                    TRER
      IF(ISQM-ISQC) 32,19,19                                             TRER
   50 K=0                                                                TRER
      DO 51 I=1,IB                                                       TRER
      K=K+KST(I)                                                         TRER
   51 CONTINUE                                                           TRER
    3 RETURN                                                             TRER
      END                                                                TRER
      SUBROUTINE SEL(IS1,IS2,IS3,NU,ISC)                                 TRER
      IF(ISC) 21,20,21                                                   TRER
   20 GO TO(1,2,3,4,5,6),NU                                              TRER
   21 GO TO(22,23,24,6),NU                                               TRER
   22 IS1=ISC                                                            TRER
      IS2=1                                                              TRER
      IS3=2                                                              TRER
      GO TO 10                                                           TRER
   23 IS3=3                                                              TRER-1
      GO TO 10                                                           TRER-1
   24 IS2=2                                                              TRER
      IS3=3                                                              TRER
      GO TO 10                                                           TRER
    1 IS1=1                                                              TRER
      IS2=2                                                              TRER
      IS3=3                                                              TRER
   10 NU=NU+1                                                            TRER
      RETURN                                                             TRER
    2 IS3=4                                                              TRER
      GO TO 10                                                           TRER
    3 IS3=5                                                              TRER
      GO TO 10                                                           TRER
    4 IS2=3                                                              TRER
      IS3=4                                                              TRER
      GO TO 10                                                           TRER
    5 IS1=2                                                              TRER
      GO TO 10                                                           TRER
    6 NU=0                                                               TRER
      RETURN                                                             TRER
      END                                                                TRER
      SUBROUTINE SELE(IS1,IS2,IS3,IS4,NU,ISC,MS,IOUT)                    TRER
      IF(NU-3) 30,30,31                                                  TRER
   31 IF(MS-NU) 13,32,32                                                 TRER
   30 IF(ISC-5)2,2,1                                                     TRER
    1 GO TO(10,11,12),NU                                                 TRER
    2 GO TO(20,21,22),NU                                                 TRER
   32 GO TO(13,13,13,35,36,37,38,13),NU                                  TRER
   10 IS1=ISC                                                            TRER
      IS2=1                                                              TRER
      IS3=2                                                              TRER
      IS4=3                                                              TRER
    3 NU=NU+1                                                            TRER
      RETURN                                                             TRER
   11 IS4=4                                                              TRER
      GO TO 3                                                            TRER
   12 IS3=3                                                              TRER
      GO TO 3                                                            TRER
   13 NU=0                                                               TRER
      RETURN                                                             TRER
   20 IS1=1                                                              TRER
      IS2=2                                                              TRER
      IS3=3                                                              TRER
      IS4=4                                                              TRER
      GO TO 3                                                            TRER
   21 IS4=5                                                              TRER
      GO TO 3                                                            TRER
   22 IS3=4                                                              TRER
      GO TO 3                                                            TRER
   35 IS1=1                                                              TRER
      IS2=3                                                              TRER
      IS3=4                                                              TRER
      IS4=5                                                              TRER
   33 WRITE(IOUT,34) IS1,IS2,IS3,IS4                                     TRER
   34 FORMAT(21H SELECTED BASE LINES=,4I3)                               TRER
      GO TO 3                                                            TRER
   36 IS2=2                                                              TRER
      IS3=3                                                              TRER
      IS4=6                                                              TRER
      GO TO 33                                                           TRER
   37 IS1=2                                                              TRER
      IS2=3                                                              TRER
      IS3=4                                                              TRER-4
      IS4=5                                                              TRER
      GO TO 33                                                           TRER
   38 IS1=1                                                              TRER
      IS2=2                                                              TRER
      IS3=3                                                              TRER
      IS4=7                                                              TRER
      GO TO 33                                                           TRER
      END                                                                TRER
      SUBROUTINE IM4(N11,N12,N13,N14,N21,N22,N23,N24,N31,N32,N33,N34,N41 TRER
     1,N42,N43,N44,NMBT,MUS,MI)                                          TRER
      IF(MI) 1,2,1                                                       TRER
    2 NMBT=N44*MD-N43*MC+N42*MB-N41*MA                                   TRER
      RETURN                                                             TRER
    1 MI=0                                                               TRER
      IF(MUS) 3,4,3                                                      TRER
    3 IAA=N13*N24-N23*N14                                                TRER
      IAB=N12*N24-N22*N14                                                TRER
      IAC=N12*N23-N22*N13                                                TRER
      IBA=N13*N24-N23*N14                                                TRER
      IBB=N11*N24-N21*N14                                                TRER
      IBC=N11*N23-N21*N13                                                TRER
      ICA=N12*N24-N22*N14                                                TRER
      ICB=N11*N24-N21*N14                                                TRER
      ICC=N11*N22-N21*N12                                                TRER
      IDA=N12*N23-N22*N13                                                TRER
      IDB=N11*N23-N21*N13                                                TRER
      IDC=N11*N22-N21*N12                                                TRER
      MUS=0                                                              TRER
    4 MA=N32*IAA-N33*IAB+N34*IAC                                         TRER
      MB=N31*IBA-N33*IBB+N34*IBC                                         TRER
      MC=N31*ICA-N32*ICB+N34*ICC                                         TRER
      MD=N31*IDA-N32*IDB+N33*IDC                                         TRER
      GO TO 2                                                            TRER
      END                                                                TRER
      SUBROUTINE RMX(A11,A12,A13,A14,A21,A22,A23,A24,A31,A32,A33,A34,A41 TRER
     1,A42,A43,A44,RMBT,M22,M3)                                          TRER
      IF(M3) 1,2,1                                                       TRER
    2 RMBT=A44*RD-A43*RC+A42*RB-A41*RA                                   TRER
      RETURN                                                             TRER
    1 M3=0                                                               TRER
      IF(M22) 3,4,3                                                      TRER
    3 RAA=A13*A24-A23*A14                                                TRER
      RAB=A12*A24-A22*A14                                                TRER
      RAC=A12*A23-A22*A13                                                TRER
      RBA=A13*A24-A23*A14                                                TRER
      RBB=A11*A24-A21*A14                                                TRER
      RBC=A11*A23-A21*A13                                                TRER
      RCA=A12*A24-A22*A14                                                TRER
      RCB=A11*A24-A21*A14                                                TRER
      RCC=A11*A22-A21*A12                                                TRER
      RDA=A12*A23-A22*A13                                                TRER
      RDB=A11*A23-A21*A13                                                TRER
      RDC=A11*A22-A21*A12                                                TRER
      M22=0                                                              TRER
    4 RA=A32*RAA-A33*RAB+A34*RAC                                         TRER
      RB=A31*RBA-A33*RBB+A34*RBC                                         TRER
      RC=A31*RCA-A32*RCB+A34*RCC                                         TRER
      RD=A31*RDA-A32*RDB+A33*RDC                                         TRER
      GO TO 2                                                            TRER
      END                                                                TRER
      SUBROUTINE RMY(A11,A12,A13,A14,A21,A22,A23,A24,A31,A32,A33,A34,A41 TRER2
     1,A42,A43,A44,RMBT,M22,M3)                                          TRER2
      IF(M3) 1,2,1                                                       TRER2
    2 RMBT=A44*RD-A43*RC+A42*RB-A41*RA                                   TRER2
      RETURN                                                             TRER2
    1 M3=0                                                               TRER2
      IF(M22) 3,4,3                                                      TRER2
    3 RAA=A13*A24-A23*A14                                                TRER2
      RAB=A12*A24-A22*A14                                                TRER2
      RAC=A12*A23-A22*A13                                                TRER2
      RBA=A13*A24-A23*A14                                                TRER2
      RBB=A11*A24-A21*A14                                                TRER2
      RBC=A11*A23-A21*A13                                                TRER2
      RCA=A12*A24-A22*A14                                                TRER2
      RCB=A11*A24-A21*A14                                                TRER2
      RCC=A11*A22-A21*A12                                                TRER2
      RDA=A12*A23-A22*A13                                                TRER2
      RDB=A11*A23-A21*A13                                                TRER2
      RDC=A11*A22-A21*A12                                                TRER2
      M22=0                                                              TRER2
    4 RA=A32*RAA-A33*RAB+A34*RAC                                         TRER2
      RB=A31*RBA-A33*RBB+A34*RBC                                         TRER2
      RC=A31*RCA-A32*RCB+A34*RCC                                         TRER2
      RD=A31*RDA-A32*RDB+A33*RDC                                         TRER2
      GO TO 2                                                            TRER2
      END                                                                TRER2
      SUBROUTINE RMZ(A11,A12,A13,A14,A21,A22,A23,A24,A31,A32,A33,A34,A41 TRER2
     1,A42,A43,A44,RMBT,M22,M3)                                          TRER2
      IF(M3) 1,2,1                                                       TRER2
    2 RMBT=A44*RD-A43*RC+A42*RB-A41*RA                                   TRER2
      RETURN                                                             TRER2
    1 M3=0                                                               TRER2
      IF(M22) 3,4,3                                                      TRER2
    3 RAA=A13*A24-A23*A14                                                TRER2
      RAB=A12*A24-A22*A14                                                TRER2
      RAC=A12*A23-A22*A13                                                TRER2
      RBA=A13*A24-A23*A14                                                TRER2
      RBB=A11*A24-A21*A14                                                TRER2
      RBC=A11*A23-A21*A13                                                TRER2
      RCA=A12*A24-A22*A14                                                TRER2
      RCB=A11*A24-A21*A14                                                TRER2
      RCC=A11*A22-A21*A12                                                TRER2
      RDA=A12*A23-A22*A13                                                TRER2
      RDB=A11*A23-A21*A13                                                TRER2
      RDC=A11*A22-A21*A12                                                TRER2
      M22=0                                                              TRER2
    4 RA=A32*RAA-A33*RAB+A34*RAC                                         TRER2
      RB=A31*RBA-A33*RBB+A34*RBC                                         TRER2
      RC=A31*RCA-A32*RCB+A34*RCC                                         TRER2
      RD=A31*RDA-A32*RDB+A33*RDC                                         TRER2
      GO TO 2                                                            TRER2
      END                                                                TRER2
      SUBROUTINE RMU(A11,A12,A13,A14,A21,A22,A23,A24,A31,A32,A33,A34,A41 TRER2
     1,A42,A43,A44,RMBT,M22,M3)                                          TRER2
      IF(M3) 1,2,1                                                       TRER2
    2 RMBT=A44*RD-A43*RC+A42*RB-A41*RA                                   TRER2
      RETURN                                                             TRER2
    1 M3=0                                                               TRER2
      IF(M22) 3,4,3                                                      TRER2
    3 RAA=A13*A24-A23*A14                                                TRER2
      RAB=A12*A24-A22*A14                                                TRER2
      RAC=A12*A23-A22*A13                                                TRER2
      RBA=A13*A24-A23*A14                                                TRER2
      RBB=A11*A24-A21*A14                                                TRER2
      RBC=A11*A23-A21*A13                                                TRER2
      RCA=A12*A24-A22*A14                                                TRER2
      RCB=A11*A24-A21*A14                                                TRER2
      RCC=A11*A22-A21*A12                                                TRER2
      RDA=A12*A23-A22*A13                                                TRER2
      RDB=A11*A23-A21*A13                                                TRER2
      RDC=A11*A22-A21*A12                                                TRER2
      M22=0                                                              TRER2
    4 RA=A32*RAA-A33*RAB+A34*RAC                                         TRER2
      RB=A31*RBA-A33*RBB+A34*RBC                                         TRER2
      RC=A31*RCA-A32*RCB+A34*RCC                                         TRER2
      RD=A31*RDA-A32*RDB+A33*RDC                                         TRER2
      GO TO 2                                                            TRER2
      END                                                                TRER2
      SUBROUTINE MOC(IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3,IH4,IK4,IL4,SQ1 TRER2
     1,SQ2,SQ3,SQ4,X,Y,Z,U,IO1,IO2,IO3,ISOLV,XL,UL,VTEST,DEN, IZTAL,     TRER2
     *VOL1,VOL2)                                                         TRER2
      DIMENSION VOL1(1),VOL2(1)                                          TRER2
      IF(IO1) 1,2,1                                                      TRER2
    1 IO1=0                                                              TRER2
      IHH1=IH1*IH1                                                       TRER2
      IKK1=IK1*IK1                                                       TRER2
      ILL1=IL1*IL1                                                       TRER2
      IHL1=IH1*IL1                                                       TRER2
      RHH1=FLOAT(IHH1)                                                   TRER2
      RKK1=FLOAT(IKK1)                                                   TRER2
      RLL1=FLOAT(ILL1)                                                   TRER2
      RHL1=FLOAT(IHL1)                                                   TRER2
    2 IF(IO2) 3,4,3                                                      TRER2
    3 IO2=0                                                              TRER2
      MA2=1                                                              TRER2
      MB2=1                                                              TRER2
      MC2=1                                                              TRER2
      MD2=1                                                              TRER2
      MUS=1                                                              TRER2
      IHH2=IH2*IH2                                                       TRER2
      IKK2=IK2*IK2                                                       TRER2
      ILL2=IL2*IL2                                                       TRER2
      IHL2=IH2*IL2                                                       TRER2
      RHH2=FLOAT(IHH2)                                                   TRER2
      RKK2=FLOAT( IKK2)                                                  TRER2
      RLL2=FLOAT(ILL2)                                                   TRER2
      RHL2=FLOAT(IHL2)                                                   TRER2
    4 IF(IO3) 5,6,5                                                      TRER2
    5 IO3=0                                                              TRER2
      MI=1                                                               TRER2
      MA=1                                                               TRER2
      MB=1                                                               TRER2
      MC=1                                                               TRER2
      MD=1                                                               TRER2
      IHH3=IH3*IH3                                                       TRER2
      IKK3=IK3*IK3                                                       TRER2
      ILL3=IL3*IL3                                                       TRER2
      IHL3=IH3*IL3                                                       TRER2
      RHH3=FLOAT(IHH3)                                                   TRER2
      RKK3=FLOAT(IKK3)                                                   TRER2
      RLL3=FLOAT(ILL3)                                                   TRER2
      RHL3=FLOAT(IHL3)                                                   TRER2
    6 IHH4=IH4*IH4                                                       TRER2
      IKK4=IK4*IK4                                                       TRER2
      ILL4=IL4*IL4                                                       TRER2
      IHL4=IH4*IL4                                                       TRER2
      CALL IM4(IHH1,IKK1,ILL1,IHL1,IHH2,IKK2,ILL2,IHL2,IHH3,IKK3,ILL3,IH TRER2
     1L3,IHH4,IKK4,ILL4,IHL4,IDET,MUS,MI)                                TRER2
      IF(IDET) 8,7,8                                                     TRER2
    7 ISOLV=0                                                            TRER2
      RETURN                                                             TRER2
    8 RDET=FLOAT(IDET)                                                   TRER2
      RHH4=FLOAT(IHH4)                                                   TRER2
      RKK4=FLOAT(IKK4)                                                   TRER2
      RLL4=FLOAT(ILL4)                                                   TRER2
      RHL4=FLOAT(IHL4)                                                   TRER2
      CALL RMU(RHH1,RKK1,RLL1,SQ1,RHH2,RKK2,RLL2,SQ2,RHH3,RKK3,RLL3,SQ3, TRER2
     1RHH4,RKK4,RLL4,SQ4,UTAK,MD2,MD)                                    TRER2
      U=UTAK/RDET                                                        TRER2
      IF(U) 7,11,11                                                      TRER2
   11 CALL RMX(SQ1,RKK1,RLL1,RHL1,SQ2,RKK2,RLL2,RHL2,SQ3,RKK3,RLL3,RHL3, TRER2
     1SQ4,RKK4,RLL4,RHL4,XTAK,MA2,MA)                                    TRER2
      X=XTAK/RDET                                                        TRER2
      IF(X-XL) 7,9,9                                                     TRER2
    9 CALL RMY(RHH1,SQ1,RLL1,RHL1,RHH2,SQ2,RLL2,RHL2,RHH3,SQ3,RLL3,RHL3, TRER2
     1RHH4,SQ4,RLL4,RHL4,YTAK,MB2,MB)                                    TRER2
      Y=YTAK/RDET                                                        TRER2
      IF(Y-XL) 7,10,10                                                   TRER2
   10 CALL RMZ(RHH1,RKK1,SQ1,RHL1,RHH2,RKK2,SQ2,RHL2,RHH3,RKK3,SQ3,RHL3, TRER2
     1RHH4,RKK4,SQ4,RHL4,ZTAK,MC2,MC)                                    TRER2
      Z=ZTAK/RDET                                                        TRER2
      IF(Z-XL) 7,13,13                                                   TRER2
   13 HALP=X*Z                                                           TRER2
C     UTE=4*COS(BETA)**2                                                 TRER2
      UTE=(U*U)/HALP                                                     TRER2
      IF(UTE-UL) 12,12,7                                                 TRER2
   12 HELP=1.0-0.25*UTE                                                  TRER2
      VST2=Y*HALP*HELP                                                   TRER2
      IF(VTEST-VST2)400,400,7                                            TRER2
  400 IF(X*HELP-XL) 7,15,15                                              TRER2
   15 IF(Z*HELP-XL) 7,14,14                                              TRER2
   14 IF(DEN-0.00001)16,16,401                                           TRER2
  401 DO 403 I=1,IZTAL                                                   TRER2
      IF(VST2-VOL1(I))403,402,402                                        TRER2
  402 IF(VST2-VOL2(I))16,16,7                                            TRER2
  403 CONTINUE                                                           TRER2
      GO TO 7                                                            TRER2
   16 ISOLV=1                                                            TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE MAEG(T1,IC,X,Y,Z,U,IB,ISQM,K,IT20,IT40)                 TRER2
      DIMENSION T1(1),IC(1),KST(30)                                      TRER2
      NX=100000.0*X                                                      TRER2
      NY=100000.0*Y                                                      TRER2
      NZ=100000.0*Z                                                      TRER2
      NU=100000.0*U                                                      TRER2
      IDH=ISQM/NX                                                        TRER2
      IDK=ISQM/NY                                                        TRER2
      IDL=ISQM/NZ                                                        TRER2
      NHM=0                                                              TRER2
      NKM=0                                                              TRER2
      NLM=0                                                              TRER2
    1 NHM=NHM+1                                                          TRER2
      IF(NHM*NHM-IDH) 1,1,2                                              TRER2
    2 NHM=NHM-1                                                          TRER2
    3 NKM=NKM+1                                                          TRER2
      IF(NKM*NKM-IDK) 3,3,4                                              TRER2
    4 NKM=NKM-1                                                          TRER2
    5 NLM=NLM+1                                                          TRER2
      IF(NLM*NLM-IDL) 5,5,6                                              TRER2
    6 NLM=NLM-1                                                          TRER2
      DO 40 I=1,IB                                                       TRER2
      KST(I)=0                                                           TRER2
   40 CONTINUE                                                           TRER2
      IH=0                                                               TRER2
      IK=0                                                               TRER2
      IL=0                                                               TRER2
      IHA=0                                                              TRER2
      IHB=0                                                              TRER2
      IHC=0                                                              TRER2
      IHD=0                                                              TRER2
      IHE=0                                                              TRER2
      IHF=0                                                              TRER2
      IHG=0                                                              TRER2
    7 IF(IH)8,10,11                                                      TRER2
    8 IH=-IH                                                             TRER2
    9 IF(IH-NHM) 10,13,13                                                TRER2
   10 IH=IH+1                                                            TRER2
      GO TO 18                                                           TRER2
   11 IF(IL) 12,9,12                                                     TRER2
   12 IH=-IH                                                             TRER2
      IHD=-IHD                                                           TRER2
      GO TO 19                                                           TRER2
   13 IH=0                                                               TRER2
      IHA=0                                                              TRER2
      IF(IL-NLM) 14,15,15                                                TRER2
   14 IL=IL+1                                                            TRER2
      GO TO 17                                                           TRER2
   15 IL=0                                                               TRER2
      IHC=0                                                              TRER2
      IHD=0                                                              TRER2
      IF(IK-NKM) 16,27,27                                                TRER2
   16 IK=IK+1                                                            TRER2
      IHB=IK*IK*NY                                                       TRER2
      IHE=IHB+IHC                                                        TRER2
      ISQC=IHB                                                           TRER2
      GO TO 20                                                           TRER2
   17 IHC=IL*IL*NZ                                                       TRER2
      IHE=IHB+IHC                                                        TRER2
      IF(ISQM-IHE) 10,18,18                                              TRER2
   18 IHA=IH*IH*NX                                                       TRER2
      IHF=IHA+IHE                                                        TRER2
      IHD=IH*IL*NU                                                       TRER2
   19 ISQC=IHF+IHD                                                       TRER2
   20 IF(ISQM-ISQC) 7,21,21                                              TRER2
   21 IF(ISQC-5000) 22,23,23                                             TRER2
   22 IT=IT20                                                            TRER2
      GO TO 24                                                           TRER2
   23 IT=IT40                                                            TRER2
   24 DO 26 I=1,IB                                                       TRER2
      ISQO=IC(I)                                                         TRER2
      IF(IABS(ISQO-ISQC)-IT) 25,25,26                                    TRER2
   25 KST(I)=1                                                           TRER2
   26 CONTINUE                                                           TRER2
      GO TO 7                                                            TRER2
   27 K=0                                                                TRER2
      DO 28 I=1,IB                                                       TRER2
      K=K+KST(I)                                                         TRER2
   28 CONTINUE                                                           TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE LAGRM(K,U)                                              TRER2
      DIMENSION VI(30)                                                   TRER2
      COMMON DEN,EDEN,RMOLV                                              TRER2
      COMMON T1(100),TAGUT(100),N1,D1,SSQTL,D2,WAVE,IHM,IKM,ILM,ISYM,INR TRER2
     1,ISUB,A11,A22,A33,A13,A12,A23,LIN(10),REV(10)                      TRER2
     2,IGOT,IS1,IS2,IS3,IS4,IA,IB,IQ,IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3 TRER2
     3,SQ1,SQ2,SQ3,X,Y,Z,IC(20),ISQM,KOTA(30),RO(4,30),ID,IIN,IOUT       TRER2
      COMMON NH1,NK1,NL1,NS1,NH2,NK2,NL2,NS2,NH3,NK3,NL3,NS3,IUTSK,IMER, TRER2
     1INIX,IOMIT,ISC,KLART,VOL,VTEST,XL,YL,IT20,IT40,CEM                 TRER2
     2,KHA,KKA,KLA,KSA,KHB,KKB,KLB,KSB,MONO,MH1,MK1,ML1,MH2,MK2,ML2,MH3, TRER2
     3MK3,ML3,MS1,MS2,MS3,MH4,MK4,ML4,MS4,UL                             TRER2
      IF(X-Z) 1,2,2                                                      TRER2
    1 XA=Z                                                               TRER2
      ZA=X                                                               TRER2
      GO TO 3                                                            TRER2
    2 XA=X                                                               TRER2
      ZA=Z                                                               TRER2
    3 UTE=(U*U)/(X*Z)                                                    TRER2
      PV=XA*Y*ZA*(1.0-UTE*0.25)                                          TRER2
      IF(ID) 7,4,7                                                       TRER2
    4 ID=ID+1                                                            TRER2
    5 I=ID                                                               TRER2
    6 RO(1,I)=XA                                                         TRER2
      RO(2,I)=Y                                                          TRER2
      RO(3,I)=ZA                                                         TRER2
      RO(4,I)=U                                                          TRER2
      KOTA(I)=K                                                          TRER2
      VI(I)=PV                                                           TRER2
      RETURN                                                             TRER2
    7 DO 11 I=1,ID                                                       TRER2
      IF(ABS(RO(1,I)-XA)-0.00005) 8,11,11                                TRER2
    8 IF(ABS(RO(2,I)-Y)-0.00005) 9,11,11                                 TRER2
    9 IF(ABS(RO(3,I)-ZA)-0.00005) 10,11,11                               TRER2
   10 IF(ABS(RO(4,I)-U)-0.00005) 20,11,11                                TRER2
   11 CONTINUE                                                           TRER2
      DO 14 I=1,ID                                                       TRER2
      IF(KOTA(I)-K) 13,12,14                                             TRER2
   12 IF(VI(I)-PV) 13,14,14                                              TRER2
   13 IF(I-5) 15,5,99                                                    TRER2
   14 CONTINUE                                                           TRER2
      IF(ID-5) 4,20,20                                                   TRER2
   15 N=4                                                                TRER2
      IF(ID-5) 16,17,17                                                  TRER2
   16 ID=ID+1                                                            TRER2
   17 M=N+1                                                              TRER2
      VI(M)=VI(N)                                                        TRER2
      KOTA(M)=KOTA(N)                                                    TRER2
      DO 18 J=1,4                                                        TRER2
      RO(J,M)=RO(J,N)                                                    TRER2
   18 CONTINUE                                                           TRER2
      IF(N-I) 99,6,19                                                    TRER2
   19 N=N-1                                                              TRER2
      GO TO 17                                                           TRER2
   99 STOP                                                               TRER2
   20 RETURN                                                             TRER-5
      END                                                                TRER2
      SUBROUTINE IMP(IH1,IK1,IL1,IH2,IK2,IL2,IOK)                        TRER2
      IF(IH1) 1,2,2                                                      TRER2
    1 IOK=1                                                              TRER2
      RETURN                                                             TRER2
    2 IF(IL1-IL2) 1,3,3                                                  TRER2
    3 IF(IK1-IK2) 1,4,4                                                  TRER2
    4 IF(IH1-IABS(IH2)) 1,5,5                                            TRER2
    5 IOK=0                                                              TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE TREOB                                                   TRER2
      DIMENSION VOL1(100),VOL2(100)                                      TRER2
      COMMON DEN,EDEN,RMOLV                                              TRER2
      COMMON T1(100),TAGUT(100),N1,D1,SSQTL,D2,WAVE,IHM,IKM,ILM,ISYM,INR TRER2
     1,ISUB,A11,A22,A33,A13,A12,A23,LIN(10),REV(10)                      TRER2
     2,IGOT,IS1,IS2,IS3,IS4,IA,IB,IQ,IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3 TRER2
     3,SQ1,SQ2,SQ3,X,Y,Z,IC(20),ISQM,KOTA(30),RO(4,30),ID,IIN,IOUT       TRER2
      COMMON NH1,NK1,NL1,NS1,NH2,NK2,NL2,NS2,NH3,NK3,NL3,NS3,IUTSK,IMER, TRER2
     1INIX,IOMIT,ISC,KLART,VOL,VTEST,XL,YL,IT20,IT40,CEM                 TRER2
     2,KHA,KKA,KLA,KSA,KHB,KKB,KLB,KSB,MONO,MH1,MK1,ML1,MH2,MK2,ML2,MH3, TRER2
     3MK3,ML3,MS1,MS2,MS3,MH4,MK4,ML4,MS4,UL,LGO,MG,MS,MRA,MRB,NU        TRER2
      GO TO(110,310,330,320,200),ISYM                                    TRER2
  400 FORMAT(25H BASE LINE ONE.(HKL)-MAX=,3I5,11H MAX H+K+L=,I5)         TRER2
  401 FORMAT(25H BASE LINE TWO.(HKL)-MAX=,3I5,11H MAX H+K+L=,I5)         TRER2
  402 FORMAT(27H BASE LINE THREE.(HKL)-MAX=,3I5,11H MAX H+K+L=,I5)       TRER2
  403 FORMAT(28H SELECTED BASE LINES (1) (2))                            TRER2
  404 FORMAT(38H SELECTED BASE LINES (1,2) (1,3) (2,3))                  TRER2
  405 FORMAT(61H SELECTED BASE LINES (1,2,3) (1,2,4) (1,2,5) (1,3,4) (2, TRER2
     13,4) )                                                             TRER2
  406 FORMAT(50H SELECTED BASE LINES (1,2,3,4) (1,2,3,5) (1,2,4,5) )     TRER2
  407 FORMAT(26H BASE LINE FOUR.(HKL)-MAX=,3I5,11H MAX H+K+L=,I5)        TRER2
  410 FORMAT(22H SELECTED BASE LINES (,I2,7H,1,2) (,I2,7H,1,3) (,I2,5H,2 TRER2
     1,3))                                                               TRER2
C     TEST CUBIC SYMMETRY                                                TRER2
  110 NOW=0                                                              TRER2
      VT=VTEST**0.3333                                                   TRER2
      IF(VT-XL) 361,362,362                                              TRER2
  361 AL=XL                                                              TRER2
      GO TO 363                                                          TRER2
  362 AL=VT                                                              TRER2
  363 WRITE(IOUT,350)                                                    TRER2
  350 FORMAT(11H CUBIC TEST)                                             TRER2
      WRITE(IOUT,403)                                                    TRER2
      WRITE(IOUT,400) KHB,KKB,KLB,KSB                                    TRER2
  111 NOW=NOW+1                                                          TRER2
      GO TO(112,113,210),NOW                                             TRER2
  112 SQ1=T1(1)                                                          TRER2
      GO TO 120                                                          TRER2
  113 SQ1=T1(2)                                                          TRER2
  120 IH1=0                                                              TRER2
      IK1=0                                                              TRER2
      IL1=0                                                              TRER2
  121 CALL GHKLA(KHB,KKB,KLB,KSB,0,IEND,IH1,IK1,IL1)                     TRER2
      IF(IEND) 122,111,122                                               TRER2
  122 CALL EKVA(IH1,IK1,IL1,0,0,0,1,ISOLV,SQ1,0.0,X,0.0,AL,0.0)          TRER2
      IF(ISOLV) 123,121,123                                              TRER2
  123 CALL TETAL(T1,X,0.0,IB,IQ,ISQM,K,IC,ISYM,IT20,IT40)                TRER2
      IF(K-IQ) 121,124,124                                               TRER2
  124 IF(IUTSK) 125,127,125                                              TRER2
  125 WRITE(IOUT,126) K,X                                                TRER2
  126 FORMAT(14H CUBIC TEST.K=,I3,3H X=,F10.6)                           TRER2
  127 CALL LAGRA(K)                                                      TRER2
      GO TO 121                                                          TRER2
C     TEST TETRAGONAL SYMMETRY                                           TRER2
  310 YL=XL                                                              TRER2
      WRITE(IOUT,351)                                                    TRER2
  351 FORMAT(16H TETRAGONAL TEST)                                        TRER2
      GO TO 150                                                          TRER2
C     TEST HEXAGONAL SYMMETRY                                            TRER2
  320 XL=(4.0*YL)/3.0                                                    TRER2
      WRITE(IOUT,352)                                                    TRER2
  352 FORMAT(15H HEXAGONAL TEST)                                         TRER2
      VTEST=(VTEST*16.0)/9.0                                             TRER2
  150 NOW=0                                                              TRER2
      WRITE(IOUT,404)                                                    TRER2
      WRITE(IOUT,400) KHA,KKA,KLA,KSA                                    TRER2
      WRITE(IOUT,401) KHA,KKA,KLA,KSA                                    TRER2
      ID=0                                                               TRER2
  151 NOW=NOW+1                                                          TRER2
      GO TO(152,153,154,210),NOW                                         TRER2
  152 SQ1=T1(1)                                                          TRER2
      SQ2=T1(2)                                                          TRER2
      GO TO 160                                                          TRER2
  153 SQ2=T1(3)                                                          TRER2
      GO TO 160                                                          TRER2
  154 SQ1=T1(2)                                                          TRER2
  160 IH1=0                                                              TRER2
      IK1=0                                                              TRER2
      IL1=0                                                              TRER2
  161 CALL GHKLA(KHA,KKA,KLA,KSA,1,IEND,IH1,IK1,IL1)                     TRER2
      IF(IEND) 162,151,162                                               TRER2
  162 IH2=0                                                              TRER2
      IK2=0                                                              TRER2
      IL2=0                                                              TRER2
      ITTE=IH1*IH1+IK1*IK1                                               TRER2
      ITTH=ITTE+IH1*IK1                                                  TRER2
  163 CALL GHKLA(KHA,KKA,KLA,KSA,1,IEND,IH2,IK2,IL2)                     TRER2
      IF(IEND) 164,161,164                                               TRER2
  164 IF(IL1-IL2) 168,165,165                                            TRER2
  165 GO TO(200,166,200,167),ISYM                                        TRER2
  166 IF(ITTE-IH2*IH2-IK2*IK2) 168,163,163                               TRER2
  167 IF(ITTH-IH2*IH2-IK2*IK2-IH2*IK2) 168,163,163                       TRER2
  168 CALL EKVA(IH1,IK1,IL1,IH2,IK2,IL2,ISYM,ISOLV,SQ1,SQ2,X,Y,XL,YL)    TRER2
      IF(ISOLV) 169,163,169                                              TRER2
  169 IF(X*X*Y-VTEST) 163,163,170                                        TRER2
  170 CALL TETAL(T1,X,Y,IB,IQ,ISQM,K,IC,ISYM,IT20,IT40)                  TRER2
      IF(K-IQ) 163,171,171                                               TRER2
  171 IF(IUTSK) 172,177,172                                              TRER2
  172 GO TO(200,173,200,175),ISYM                                        TRER2
  173 WRITE(IOUT,174) K,X,Y                                              TRER2
  174 FORMAT(19H TETRAGONAL TEST.K=,I3,4H XY=,2F10.6)                    TRER2
      GO TO 177                                                          TRER2
  175 WRITE(IOUT,176) K,X,Y                                              TRER2
  176 FORMAT(18H HEXAGONAL TEST.K=,I3,4H XY=,2F10.6)                     TRER2
  177 CALL LAGRA(K)                                                      TRER2
      GO TO 163                                                          TRER2
C     TEST ORTHOROMBIC SYMMETRY                                          TRER2
  330 XL=(WAVE*WAVE)/(4.0*CEM*CEM)                                       TRER2
      WRITE(IOUT,353)                                                    TRER2
  353 FORMAT(18H ORTHORHOMBIC TEST)                                      TRER2
      IF(ISC) 411,412,411                                                TRER2
  411 WRITE(IOUT,410) ISC,ISC,ISC                                        TRER2
      GO TO 413                                                          TRER2
  412 WRITE(IOUT,405)                                                    TRER2
  413 WRITE(IOUT,400) NH1,NK1,NL1,NS1                                    TRER2
      WRITE(IOUT,401) NH2,NK2,NL2,NS2                                    TRER2
      WRITE(IOUT,402) NH3,NK3,NL3,NS3                                    TRER2
      IF(DEN-0.00001)461,461,601                                         TRER2
  601 IZTAL=0                                                            TRER2
  490 IZTAL=IZTAL+1                                                      TRER2
      RVA=(IZTAL*RMOLV)/(0.6023*(DEN+EDEN))                              TRER2
      IF(RVA-VOL)490,490,465                                             TRER2
  465 RVA=(WAVE**6)*((0.6023*(DEN+EDEN))**2)                             TRER2
      RVB=(WAVE**6)*((0.6023*(DEN-EDEN))**2)                             TRER2
      DO 466 I=1,IZTAL                                                   TRER2
      VOL1(I)=RVB/(64.0*(I*RMOLV)**2)                                    TRER2
      VOL2(I)=RVA/(64.0*(I*RMOLV)**2)                                    TRER2
  466 CONTINUE                                                           TRER2
  461 ID=0                                                               TRER2
      VTEST=(WAVE**6)/(64.0*VOL*VOL)                                     TRER2
      NU=1                                                               TRER2
    5 CALL SEL(IS1,IS2,IS3,NU,ISC)                                       TRER2
      IF(NU) 210,210,7                                                   TRER2
C                                                                        TRER2
C     NEW HKL ON FIRST LINE                                              TRER2
    7 IH1=0                                                              TRER2
      IK1=0                                                              TRER2
      IL1=0                                                              TRER2
      SQ1=T1(IS1)                                                        TRER2
      SQ2=T1(IS2)                                                        TRER2
      SQ3=T1(IS3)                                                        TRER2
    8 CALL GHKLA(NH1,NK1,NL1,NS1,0,IEND,IH1,IK1,IL1)                     TRER2
      IF(IEND) 9,5,9                                                     TRER2
    9 IH2=0                                                              TRER2
      IK2=0                                                              TRER2
      IL2=0                                                              TRER2
      IO1=1                                                              TRER2
C     NEW HKL ON SECOND LINE                                             TRER2
   10 CALL GEHKL(NH2,NK2,NL2,NS2,1,ISLUT,IH2,IK2,IL2)                    TRER2
      IF(ISLUT) 11,8,11                                                  TRER2
   11 IF(IH1-IK1) 21,20,21                                               TRER2
   20 IF(IH2-IK2) 10,21,21                                               TRER2
   21 IF(IK1-IL1) 23,22,23                                               TRER2
   22 IF(IK2-IL2) 10,23,23                                               TRER2
   23 IF(IH1-IH2) 60,61,61                                               TRER2
   61 IF(IK1-IK2) 60,62,62                                               TRER2
   62 IF(IL1-IL2) 60,10,10                                               TRER2
   60 IH3=0                                                              TRER2
      IK3=0                                                              TRER2
      IL3=0                                                              TRER2
      IO2=1                                                              TRER2
C     NEW HKL ON THIRD LINE                                              TRER2
    3 CALL GEHKL(NH3,NK3,NL3,NS3,1,ISLUT,IH3,IK3,IL3)                    TRER2
       IF(ISLUT) 65,10,65                                                TRER2
   65 IF(IH2-IH3) 13,66,66                                               TRER2
   66 IF(IK2-IK3) 13,67,67                                               TRER2
   67 IF(IL2-IL3) 13,3,3                                                 TRER2
C     CALL XYZ ORTHOR. SYM.                                              TRER2
   13 CALL ORT(IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3,ISOLV,SQ1,SQ2,SQ3,X,Y TRER2
     1,Z,IO1,IO2,XL)                                                     TRER2
      IF(ISOLV) 53,3,53                                                  TRER2
   53 RVA=X*Y*Z                                                          TRER2
      IF(VTEST-RVA)480,480,3                                             TRER2
  480 IF(DEN-0.00001)14,14,479                                           TRER2
  479 DO 476 I=1,IZTAL                                                   TRER2
      IF(RVA-VOL1(I))476,478,478                                         TRER2
  478 IF(RVA-VOL2(I))14,14,3                                             TRER2
  476 CONTINUE                                                           TRER2
      GO TO 3                                                            TRER2
C     CALC. NUMBER OF INDEXABLE LINES                                    TRER2
   14 CALL ORTAL(T1,X,Y,Z,N1,IB,IQ,ISQM,K,IC,IT20,IT40)                  TRER2
      IF(K-IQ) 3,15,15                                                   TRER2
   15 IF(IUTSK) 17,16,17                                                 TRER2
   17 WRITE(IOUT,101) K,X,Y,Z                                            TRER2
C                                                                        TRER2
  101 FORMAT(20H ORTHOROMBIC TEST.K=,I3,5H XYZ=,3F10.6)                  TRER2
   16 CALL LAGRA(K)                                                      TRER2
      GO TO 3                                                            TRER2
  210 IGOT=0                                                             TRER2
      MRA=ID                                                             TRER2
      GO TO 900                                                          TRER2
C     TEST MONOCLINIC SYMMETRY                                           TRER2
  200 ID=0                                                               TRER2
      IF(NU) 542,542,540                                                 TRER2
  542 NU=1                                                               TRER2
      IF(MONO) 541,541,500                                               TRER2
  500 WRITE(IOUT,511)                                                    TRER2
  511 FORMAT(16H MONOCLINIC TEST)                                        TRER2
      IF(DEN-0.00001)602,602,603                                         TRER2
  603 IZTAL=0                                                            TRER2
  604 IZTAL=IZTAL+1                                                      TRER2
      RVA=(IZTAL*RMOLV)/(0.6023*(DEN+EDEN))                              TRER2
      IF(RVA-VOL)604,604,605                                             TRER2
  605 RVA=(WAVE**6)*((0.6023*(DEN+EDEN))**2)                             TRER2
      RVB=(WAVE**6)*((0.6023*(DEN-EDEN))**2)                             TRER2
      DO 606 I=1,IZTAL                                                   TRER2
      VOL1(I)=RVB/(64.0*(I*RMOLV)**2)                                    TRER2
      VOL2(I)=RVA/(64.0*(I*RMOLV)**2)                                    TRER2
  606 CONTINUE                                                           TRER2
  602 WRITE(IOUT,512) MONO                                               TRER2
  512 FORMAT(18H MAX BETA ALLOWED=,I5,5H DEG.)                           TRER2
      IF(ISC-5) 515,515,513                                              TRER2
  513 WRITE(IOUT,514) ISC,ISC,ISC                                        TRER2
  514 FORMAT(22H SELECTED BASE LINES (,I2,9H,1,2,3) (,I2,9H,1,2,4) (,I2, TRER2
     17H,1,3,4))                                                         TRER2
      GO TO 516                                                          TRER2
  515 WRITE(IOUT,406)                                                    TRER2
  516 WRITE(IOUT,400) MH1,MK1,ML1,MS1                                    TRER2
      WRITE(IOUT,401) MH2,MK2,ML2,MS2                                    TRER2
      WRITE(IOUT,402) MH3,MK3,ML3,MS3                                    TRER2
      WRITE(IOUT,407) MH4,MK4,ML4,MS4                                    TRER2
      GO TO 540                                                          TRER2
  517 IF(MG) 210,540,210                                                 TRER2
  540 CALL SELE(IS1,IS2,IS3,IS4,NU,ISC,MS,IOUT)                          TRER2
      IF(NU) 541,541,518                                                 TRER2
  541 MG=0                                                               TRER2
      GO TO 210                                                          TRER2
  518 SQ1=T1(IS1)                                                        TRER2
      SQ2=T1(IS2)                                                        TRER2
      SQ3=T1(IS3)                                                        TRER2
      SQ4=T1(IS4)                                                        TRER2
      IF(SQ1-SQ2) 590,591,591                                            TRER2
  590 INIMP=1                                                            TRER2
      GO TO 592                                                          TRER2
  591 INIMP=0                                                            TRER2
  592 IH1=0                                                              TRER2
      IK1=0                                                              TRER2
      IL1=0                                                              TRER2
  519 CALL GEHKL(MH1,MK1,ML1,MS1,2,ISLUT,IH1,IK1,IL1)                    TRER2
      IF(ISLUT) 520,517,520                                              TRER2
  520 IF(IH1) 522,521,521                                                TRER2
  521 IF(IH1-IL1) 519,522,522                                            TRER2
  522 IH2=0                                                              TRER2
      IK2=0                                                              TRER2
      IL2=0                                                              TRER2
      IO1=1                                                              TRER2
  523 CALL GEHKL(MH2,MK2,ML2,MS2,2,ISLUT,IH2,IK2,IL2)                    TRER2
      IF(ISLUT) 524,519,524                                              TRER2
  524 IF(INIMP) 593,580,593                                              TRER2
  593 CALL IMP(IH1,IK1,IL1,IH2,IK2,IL2,IOK)                              TRER2
      IF(IOK) 580,523,580                                                TRER2
  580 IH3=0                                                              TRER2
      IK3=0                                                              TRER2
      IL3=0                                                              TRER2
      IO2=1                                                              TRER2
  525 CALL GEHKL(MH3,MK3,ML3,MS3,2,ISLUT,IH3,IK3,IL3)                    TRER2
      IF(ISLUT) 526,523,526                                              TRER2
  526 CALL IMP(IH2,IK2,IL2,IH3,IK3,IL3,IOK)                              TRER2
      IF(IOK) 581,525,581                                                TRER2
  581 IF(INIMP) 594,582,594                                              TRER2
  594 CALL IMP(IH1,IK1,IL1,IH3,IK3,IL3,IOK)                              TRER2
      IF(IOK) 582,525,582                                                TRER2
  582 IH4=0                                                              TRER2
      IK4=0                                                              TRER2
      IL4=0                                                              TRER2
      IO3=1                                                              TRER2
  527 CALL GEHKL(MH4,MK4,ML4,MS4,2,ISLUT,IH4,IK4,IL4)                    TRER2
      IF(ISLUT) 583,525,583                                              TRER2
  583 CALL IMP(IH3,IK3,IL3,IH4,IK4,IL4,IOK)                              TRER2
      IF(IOK) 584,527,584                                                TRER2
  584 CALL IMP(IH2,IK2,IL2,IH4,IK4,IL4,IOK)                              TRER2
      IF(IOK) 585,527,585                                                TRER2
  585 IF(INIMP) 595,528,595                                              TRER2
  595 CALL IMP(IH1,IK1,IL1,IH4,IK4,IL4,IOK)                              TRER2
      IF(IOK)528,527,528                                                 TRER2
  528 CALL MOC(IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3,IH4,IK4,IL4,SQ1,SQ2,S TRER2
     1Q3,SQ4,X,Y,Z,U,IO1,IO2,IO3,ISOLV,XL,UL,VTEST,DEN,IZTAL,VOL1,VOL2)  TRER2
      IF(ISOLV) 529,527,529                                              TRER2
  529 CALL MAEG(T1,IC,X,Y,Z,U,IB,ISQM,K,IT20,IT40)                       TRER2
      IF(K-IQ) 527,530,530                                               TRER2
  530 IF(IUTSK) 531,533,531                                              TRER2
  531 WRITE(IOUT,532) K,X,Y,Z,U                                          TRER2
  532 FORMAT(20H MONOCLINIC TEST. K=,I3,6H XYZU=,4F10.6)                 TRER2
  533 CALL LAGRM(K,U)                                                    TRER2
      GO TO 527                                                          TRER2
  900 RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE TREOC(IGOE)                                             TRER2
      DIMENSION NVD(210),NDS(210)                                        TRER2
      COMMON DEN,EDEN,RMOLV                                              TRER2
      COMMON T1(100),TAGUT(100),N1,D1,SSQTL,D2,WAVE,IHM,IKM,ILM,ISYM,INR TRER2
     1,ISUB,A11,A22,A33,A13,A12,A23,LIN(10),REV(10)                      TRER2
     2,IGOT,IS1,IS2,IS3,IS4,IA,IB,IQ,IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3 TRER2
     3,SQ1,SQ2,SQ3,X,Y,Z,IC(20),ISQM,KOTA(30),RO(4,30),ID,IIN,IOUT       TRER2
      COMMON NH1,NK1,NL1,NS1,NH2,NK2,NL2,NS2,NH3,NK3,NL3,NS3,IUTSK,IMER, TRER2
     1INIX,IOMIT,ISC,KLART,VOL,VTEST,XL,YL,IT20,IT40,CEM                 TRER2
     2,KHA,KKA,KLA,KSA,KHB,KKB,KLB,KSB,MONO,MH1,MK1,ML1,MH2,MK2,ML2,MH3, TRER2
     3MK3,ML3,MS1,MS2,MS3,MH4,MK4,ML4,MS4,UL,LGO,MG,MS,MRA,MRB,NU        TRER2
C     COMMON CARDS                                                       TRER2
      A11=0.0                                                            TRER2
      A22=0.0                                                            TRER2
      A33=0.0                                                            TRER2
      IF(IGOT) 2,1,2                                                     TRER2
    1 LIN(10)=ISYM                                                       TRER2
C      FROM TREOB                                                        TRER2
      IGOT=1                                                             TRER2
    2 IF(ID) 3,4,3                                                       TRER2
    3 ISYM=LIN(10)                                                       TRER2
      INR=3                                                              TRER2
      I=MRA+1-ID                                                         TRER2
      K=KOTA(I)                                                          TRER2
      ID=ID-1                                                            TRER2
      GO TO(11,12,13,12,150),ISYM                                        TRER2
  150 A11=RO(3,I)                                                        TRER2
      A22=RO(2,I)                                                        TRER2
      A33=RO(1,I)                                                        TRER2
      A13=RO(4,I)                                                        TRER2
      WRITE(IOUT,151)K,A11,A22,A33,A13                                   TRER2
  151 FORMAT(3H K=,I3,6H XYZU=,4F10.6)                                   TRER2
      GO TO 30                                                           TRER2
   11 A11=RO(1,I)                                                        TRER2
      WRITE(IOUT,20) K,A11                                               TRER2
   20 FORMAT(3H K=,I3,3H X=,F10.5)                                       TRER2
      GO TO 30                                                           TRER2
   12 A11=RO(1,I)                                                        TRER2
      A22=RO(2,I)                                                        TRER2
      WRITE(IOUT,21) K,A11,A22                                           TRER2
   21 FORMAT(3H K=,I3,4H XY=,2F10.5)                                     TRER2
      GO TO 30                                                           TRER2
   13 A11=RO(3,I)                                                        TRER2
      A22=RO(2,I)                                                        TRER2
      A33=RO(1,I)                                                        TRER2
      WRITE(IOUT,22) K,A11,A22,A33                                       TRER2
   22 FORMAT(3H K=,I3,5H XYZ=,3F10.5)                                    TRER2
   30 IGOE=1                                                             TRER2
      RETURN                                                             TRER2
    4 ISYM=LIN(10)                                                       TRER2
      GO TO(31,32,152,34,33),ISYM                                        TRER2
   31 ISYM=2                                                             TRER2
      GO TO 40                                                           TRER2
   32 ISYM=4                                                             TRER2
      GO TO 40                                                           TRER2
   34 ISYM=3                                                             TRER2
      GO TO 40                                                           TRER2
  152 ISYM=5                                                             TRER2
   40 IGOE=2                                                             TRER2
      RETURN                                                             TRER2
   33 IF(MG) 40,153,40                                                   TRER2
  153 IF(IB-20) 51,50,50                                                 TRER2
   50 NDTAL=20                                                           TRER2
      GO TO 52                                                           TRER2
   51 NDTAL=IB                                                           TRER2
   52 WRITE(IOUT,101)                                                    TRER2
  101 FORMAT(32H PROGRAM FOR DIFFERENCE ANALYSIS,/,57H PROGRAM I1  REF&  TRER2
     1 WERNER,P-E., Z.KRIST. 120(1964)375-378)                           TRER2
      WRITE(IOUT,53)NDTAL,D2,D2                                          TRER2
   53 FORMAT(35H NUMBER OF SINE SQUARE(THETA) USED=,I5,/,32H DELTA=X/16  TRER2
     1IF THIS IS LESS THAN,F10.5,17H OTHERWISE DELTA=,F10.5)             TRER2
      IXT=800                                                            TRER2
      DO 54 I=1,210                                                      TRER2
      NVD(I)=0                                                           TRER2
      NDS(I)=0                                                           TRER2
   54 CONTINUE                                                           TRER2
      L=0                                                                TRER2
      J=0                                                                TRER2
      I=NDTAL+1                                                          TRER2
   55 I=I-1                                                              TRER2
      IF(I-2) 59,56,56                                                   TRER2
   56 J=J+1                                                              TRER2
      NVD(J)=IC(I)                                                       TRER2
      K=I                                                                TRER2
   57 K=K-1                                                              TRER2
      IF(K) 55,55,58                                                     TRER2
   58 J=J+1                                                              TRER2
      NVD(J)=IC(I)-IC(K)                                                 TRER2
      GO TO 57                                                           TRER2
   59 J=J+1                                                              TRER2
      NVD(J)=IC(I)                                                       TRER2
      NUTAL=J                                                            TRER2
      DO 68 I=1,NUTAL                                                    TRER2
      NDSI=0                                                             TRER2
      NVDI=NVD(I)                                                        TRER2
      NDELT=NVDI/16                                                      TRER2
      IF(NDELT-IT40) 61,61,60                                            TRER2
   60 NDELT=IT40                                                         TRER2
   61 DO 67 J=1,NUTAL                                                    TRER2
      IF(I-J) 62,67,62                                                   TRER2
   62 NTEST=NVD(J)                                                       TRER2
      N=NTEST/NVDI                                                       TRER2
      IF(N) 67,67,200                                                    TRER2
  200 NMULT=N*NVDI                                                       TRER2
   66 IF(NMULT+NDELT-NTEST) 65,63,63                                     TRER2
   63 IF(NMULT-NDELT-NTEST) 64,64,67                                     TRER2
   64 NDSI=NDSI+1                                                        TRER2
      GO TO 67                                                           TRER2
   65 NMULT=NMULT+NVDI                                                   TRER2
      GO TO 66                                                           TRER2
   67 CONTINUE                                                           TRER2
      NDS(I)=NDSI                                                        TRER2
   68 CONTINUE                                                           TRER2
      MAXDF=IC(NDTAL)                                                    TRER2
      RAXDF=FLOAT(MAXDF)                                                 TRER2
      NUMER=0                                                            TRER2
      WRITE(IOUT,69)                                                     TRER2
   69 FORMAT(22H   NR MULT. DIFF.TABLE)                                  TRER2
      DO 75 I=1,NUTAL                                                    TRER2
      NSMAX=-1                                                           TRER2
      DO 71 J=1,NUTAL                                                    TRER2
      N=NDS(J)                                                           TRER2
      IF(N-NSMAX) 71,71,70                                               TRER2
   70 NSMAX=N                                                            TRER2
      JAKT=J                                                             TRER2
   71 CONTINUE                                                           TRER2
      NVDA=NVD(JAKT)                                                     TRER2
      SQDIF=FLOAT(NVDA)/100000.0                                         TRER2
      NDS(JAKT)=-1                                                       TRER2
      NFORM=0                                                            TRER2
   72 NFORM=NFORM+1                                                      TRER2
      IF(NFORM-10) 73,74,74                                              TRER2
   73 RVAL=RAXDF*(0.66667**NFORM)                                        TRER2
      RNVDA=FLOAT(NVDA)                                                  TRER2
      IF(RVAL-RNVDA) 74,74,72                                            TRER2
   74 NUMER=NUMER+1                                                      TRER2
      GO TO(81,82,83,84,85,86,87,88,89,90),NFORM                         TRER2
   81 WRITE(IOUT,91) NUMER,NSMAX,SQDIF                                   TRER2
   91 FORMAT(2I5,81X,F9.6)                                               TRER-1
      GO TO 75                                                           TRER-1
   82 WRITE(IOUT,92) NUMER,NSMAX,SQDIF                                   TRER2
   92 FORMAT(2I5,72X,F9.6)                                               TRER2
      GO TO 75                                                           TRER2
   83 WRITE(IOUT,93) NUMER,NSMAX,SQDIF                                   TRER2
   93 FORMAT(2I5,63X,F9.6)                                               TRER2
      GO TO 75                                                           TRER2
   84 WRITE(IOUT,94) NUMER,NSMAX,SQDIF                                   TRER2
   94 FORMAT(2I5,54X,F9.6)                                               TRER2
      GO TO 75                                                           TRER2
   85 WRITE(IOUT,95) NUMER,NSMAX,SQDIF                                   TRER2
   95 FORMAT(2I5,45X,F9.6)                                               TRER2
      GO TO 75                                                           TRER2
   86 WRITE(IOUT,96) NUMER,NSMAX,SQDIF                                   TRER2
   96 FORMAT(2I5,36X,F9.6)                                               TRER2
      GO TO 75                                                           TRER2
   87 WRITE(IOUT,97) NUMER,NSMAX,SQDIF                                   TRER2
   97 FORMAT(2I5,27X,F9.6)                                               TRER2
      GO TO 75                                                           TRER2
   88 WRITE(IOUT,98) NUMER,NSMAX,SQDIF                                   TRER2
   98 FORMAT(2I5,18X,F9.6)                                               TRER2
      GO TO 75                                                           TRER2
   89 WRITE(IOUT,99) NUMER,NSMAX,SQDIF                                   TRER2
   99 FORMAT(2I5,9X,F9.6)                                                TRER2
      GO TO 75                                                           TRER2
   90 WRITE(IOUT,100) NUMER,NSMAX,SQDIF                                  TRER2
  100 FORMAT(2I5,F9.6)                                                   TRER2
   75 CONTINUE                                                           TRER2
      WRITE(IOUT,76)                                                     TRER2
   76 FORMAT(14H TEST FINISHED)                                          TRER2
      IGOE=3                                                             TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE EX(IH,IK,IL,IJ)                                         TRER2
      IJ=1                                                               TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE PW71(T2,IHT,IKT,ILT,IQE,ISYM,N2,A11,A22,A33,A13,A12,A23 TRER2
     1,V2,NEKV)                                                          TRER2
      DIMENSION T2(1),IHT(1),IKT(1),ILT(1),IQE(1)                        TRER2
      V2=0                                                               TRER2
      NEKV=0                                                             TRER2
      DO 7 I=1,N2                                                        TRER2
      IF(IQE(I)) 8,7,8                                                   TRER2
    8 GO TO(1,2,3,4,5,6),ISYM                                            TRER2
    1 SQ=(IHT(I)**2+IKT(I)**2+ILT(I)**2)*A11                             TRER2
      GO TO 9                                                            TRER2
    2 SQ=(IHT(I)**2+IKT(I)**2)*A11+ILT(I)*ILT(I)*A22                     TRER2
      GO TO 9                                                            TRER2
    3 SQ=(IHT(I)**2)*A11+(IKT(I)**2)*A22+(ILT(I)**2)*A33                 TRER2
      GO TO 9                                                            TRER2
    4 SQ=(IHT(I)**2+IHT(I)*IKT(I)+IKT(I)**2)*A11+(ILT(I)**2)*A22         TRER2
      GO TO 9                                                            TRER2
    5 SQ=(IHT(I)**2)*A11+(IKT(I)**2)*A22+(ILT(I)**2)*A33+(IHT(I)*ILT(I)* TRER2
     1A13)                                                               TRER2
      GO TO 9                                                            TRER2
    6 SQ=(IHT(I)**2)*A11+(IKT(I)**2)*A22+(ILT(I)**2)*A33+ IHT(I)*ILT(I)* TRER2
     1A13+IHT(I)*IKT(I)*A12+IKT(I)*ILT(I)*A23                            TRER2
    9 V2=V2+(T2(I)-SQ)**2                                                TRER2
      NEKV=NEKV+1                                                        TRER2
    7 CONTINUE                                                           TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE PW50(A11,A22,A33,A13,A12,A23,ISYM,IHM,IKM,ILM,IH,IK,IL, TRER2
     1SSQT,IA)                                                           TRER2
C     SE P-E 850                                                         TRER2
      IA=1                                                               TRER2
      GO TO(1,2,3,4,5,6),ISYM                                            TRER2
    1 IF(IH-IHM) 7,8,8                                                   TRER2
    7 IH=IH+1                                                            TRER2
      GO TO 10                                                           TRER2
    8 IF(IK-IKM) 9,11,11                                                 TRER2
    9 IK=IK+1                                                            TRER2
      IH=IK                                                              TRER2
      GO TO 10                                                           TRER2
   11 IF(IL-ILM) 12,13,13                                                TRER2
   12 IL=IL+1                                                            TRER2
      IK=IL                                                              TRER2
      IH=IK                                                              TRER2
   10 SSQT=FLOAT(IH*IH+IK*IK+IL*IL)*A11                                  TRER2
      RETURN                                                             TRER2
   13 IA=0                                                               TRER2
      RETURN                                                             TRER2
    2 IF(IH-IHM) 14,15,15                                                TRER2
   14 IH=IH+1                                                            TRER2
      GO TO 20                                                           TRER2
   15 IF(IK-IKM) 16,17,17                                                TRER2
   16 IK=IK+1                                                            TRER2
      IH=IK                                                              TRER2
      GO TO 20                                                           TRER2
   17 IF(IL-ILM) 18,13,13                                                TRER2
   18 IL=IL+1                                                            TRER2
      IH=0                                                               TRER2
      IK=0                                                               TRER2
   20 SSQT=FLOAT(IH*IH+IK*IK)*A11+FLOAT(IL*IL)*A22                       TRER2
      RETURN                                                             TRER2
    3 IF(IH-IHM) 21,22,22                                                TRER2
   21 IH=IH+1                                                            TRER2
      GO TO 30                                                           TRER2
   22 IH=0                                                               TRER2
      IF(IK-IKM) 23,24,24                                                TRER2
   23 IK=IK+1                                                            TRER2
      GO TO 30                                                           TRER2
   24 IF(IL-ILM) 25,13,13                                                TRER2
   25 IK=0                                                               TRER2
      IL=IL+1                                                            TRER2
   30 SSQT=FLOAT(IH*IH)*A11+FLOAT(IK*IK)*A22+FLOAT(IL*IL)*A33            TRER2
      RETURN                                                             TRER2
C     CHANGE S50/46,47,48,49,50,54                                       TRER2
C                                                                        TRER2
C                                                                        TRER2
    4 IF(IH-IHM) 33,34,34                                                TRER2
   33 IH=IH+1                                                            TRER2
      GO TO 40                                                           TRER2
   34 IF(IK-IKM) 35,36,36                                                TRER2
   35 IK=IK+1                                                            TRER2
      IH=IK                                                              TRER2
      GO TO 40                                                           TRER2
   36 IF(IL-ILM) 37,13,13                                                TRER2
   37 IH=0                                                               TRER2
      IK=0                                                               TRER2
      IL=IL+1                                                            TRER2
   40 SSQT=FLOAT(IH*IH+IH*IK+IK*IK)*A11+FLOAT(IL*IL)*A22                 TRER2
      RETURN                                                             TRER2
    5 IF(IH*IL)42,42,41                                                  TRER2
   41 IH=-IH                                                             TRER2
      GO TO 50                                                           TRER2
   42 IF(IABS(IH)-IHM) 43,44,44                                          TRER2
   43 IH=IABS(IH)+1                                                      TRER2
      GO TO 50                                                           TRER2
   44 IH=0                                                               TRER2
      IF(IK-IKM)45,46,46                                                 TRER2
   45 IK=IK+1                                                            TRER2
      GO TO 50                                                           TRER2
   46 IF(IL-ILM) 47,13,13                                                TRER2
   47 IK=0                                                               TRER2
      IL=IL+1                                                            TRER2
   50 SSQT=FLOAT(IH*IH)*A11+FLOAT(IK*IK)*A22+FLOAT(IL*IL)*A33+FLOAT(IH*I TRER2
     1L)*A13                                                             TRER2
      RETURN                                                             TRER2
    6 IF(IABS(IK)+IL) 51,52,51                                           TRER2
   51 IF(IH) 52,52,53                                                    TRER2
   53 IH=-IH                                                             TRER2
      GO TO 60                                                           TRER2
   52 IF(IABS(IH)-IHM) 54,55,55                                          TRER2
   54 IH=IABS(IH)+1                                                      TRER2
      GO TO 60                                                           TRER2
   55 IH=0                                                               TRER2
      IF(IL) 57,57,56                                                    TRER2
   56 IF(IK) 57,57,58                                                    TRER2
   58 IK=-IK                                                             TRER2
      GO TO 60                                                           TRER2
   57 IF(IABS(IK)-IKM) 59,61,61                                          TRER2
   59 IK=IABS(IK)+1                                                      TRER2
      GO TO 60                                                           TRER2
   61 IK=0                                                               TRER2
      IF(IL-ILM) 62,13,13                                                TRER2
   62 IL=IL+1                                                            TRER2
   60 SSQT=FLOAT(IH*IH)*A11+FLOAT(IK*IK)*A22+FLOAT(IL*IL)*A33+FLOAT(IH*I TRER2
     1L)*A13+FLOAT(IH*IK)*A12+FLOAT(IK*IL)*A23                           TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE PW51(SSQT,T1,N,SSQTL,D1,D2,SSQTO,IA)                    TRER2
      DIMENSION T1(1)                                                    TRER2
C     SE P-E 852                                                         TRER2
      IF(SSQT-SSQTL) 1,2,2                                               TRER2
    1 D=D1                                                               TRER2
      GO TO 3                                                            TRER2
    2 D=D2                                                               TRER2
    3 DO 4 I=1,N                                                         TRER2
      IF(ABS(SSQT-T1(I))-D) 5,5,4                                        TRER2
    4 CONTINUE                                                           TRER2
      IA=0                                                               TRER2
      RETURN                                                             TRER2
    5 IA=1                                                               TRER2
      SSQTO=T1(I)                                                        TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE PW53(SSQTO,T2,N2,IHT,IKT,ILT,IQE,IH,IK,IL,ISYM)         TRER2
C     SE P-E 853 OBS. N2 START=0                                         TRER2
      DIMENSION T2(1),IHT(1),IKT(1),ILT(1),IQE(1)                        TRER2
      I=1                                                                TRER2
    5 IF(I-N2) 2,2,1                                                     TRER2
    1 T2(I)=SSQTO                                                        TRER2
      IHT(I)=IH                                                          TRER2
      IKT(I)=IK                                                          TRER2
      ILT(I)=IL                                                          TRER2
      IQE(I)=1                                                           TRER2
      GO TO 26                                                           TRER2
    2 IF(SSQTO-T2(I)) 3,4,3                                              TRER2
    3 I=I+1                                                              TRER2
      GO TO 5                                                            TRER2
    4 GO TO (11,12,13,14,15,16),ISYM                                     TRER2
   11 IF((IH**2+IK**2+IL**2)-(IHT(I)**2+IKT(I)**2+ILT(I)**2))7,6,7       TRER2
    7 IQE(I)=0                                                           TRER2
      RETURN                                                             TRER2
   12 IF((IH**2+IK**2)-(IHT(I)**2+IKT(I)**2)) 7,21,7                     TRER2
   21 IF(IL**2-ILT(I)**2) 7,6,7                                          TRER2
   13 IF(IH**2-IHT(I)**2) 7,22,7                                         TRER2
   22 IF(IK**2-IKT(I)**2) 7,21,7                                         TRER2
   14 IF((IH**2+IH*IK+IK**2)-(IHT(I)**2+IHT(I)*IKT(I)+IKT(I)**2))7,21,7  TRER2
   15 IF(IH*IL-IHT(I)*ILT(I)) 7,13,7                                     TRER2
   16 IF(IH*IK-IHT(I)*IKT(I)) 7,23,7                                     TRER2
   23 IF(IK*IL-IKT(I)*ILT(I)) 7,15,7                                     TRER2
   26 SSQTO=-SSQTO                                                       TRER2
    6 RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE PW54(A,N,B,M,DET)                                       TRER2
C     M=0 GER AINV,M=1 DESSUTOM X I B-VEKTORN                            TRER2
      DIMENSION IPIV(6),A(6,6),B(6,1),INDEX(6,2),PIVOT(6)                TRER2
      EQUIVALENCE (IROW,JROW),(ICOL,JCOL),(AMAX,T,SWAP)                  TRER2
      DET=1.0                                                            TRER2
      DO 20 J=1,N                                                        TRER2
   20 IPIV(J)=0                                                          TRER2
      DO 550 I=1,N                                                       TRER2
      AMAX=0.0                                                           TRER2
      DO 105 J=1,N                                                       TRER2
      IF(IPIV(J)-1) 60,105,60                                            TRER2
   60 DO 100 K=1,N                                                       TRER2
      IF(IPIV(K)-1) 80,100,740                                           TRER2
   80 IF(ABS(AMAX)-ABS(A(J,K))) 85,100,100                               TRER2
   85 IROW=J                                                             TRER2
      ICOL=K                                                             TRER2
      AMAX=A(J,K)                                                        TRER2
  100 CONTINUE                                                           TRER2
  105 CONTINUE                                                           TRER2
      IPIV(ICOL)=IPIV(ICOL)+1                                            TRER2
      IF(IROW-ICOL) 140,260,140                                          TRER2
  140 DET=-DET                                                           TRER2
      DO 200 L=1,N                                                       TRER2
      SWAP=A(IROW,L)                                                     TRER2
      A(IROW,L)=A(ICOL,L)                                                TRER2
  200 A(ICOL,L)=SWAP                                                     TRER2
      IF(M)260,260,210                                                   TRER2
  210 DO 250 L=1,M                                                       TRER2
      SWAP=B(IROW,L)                                                     TRER2
      B(IROW,L)=B(ICOL,L)                                                TRER2
  250 B(ICOL,L)=SWAP                                                     TRER2
  260 INDEX(I,1)=IROW                                                    TRER2
      INDEX(I,2)=ICOL                                                    TRER2
      PIVOT(I)=A(ICOL,ICOL)                                              TRER2
      DET=DET*PIVOT(I)                                                   TRER2
      A(ICOL,ICOL)=1.0                                                   TRER2
      DO 350 L=1,N                                                       TRER2
  350 A(ICOL,L)=A(ICOL,L)/PIVOT(I)                                       TRER2
      IF(M) 380,380,360                                                  TRER2
  360 DO 370 L=1,M                                                       TRER2
  370 B(ICOL,L)=B(ICOL,L)/PIVOT(I)                                       TRER2
  380 DO 550 L1=1,N                                                      TRER2
      IF(L1-ICOL) 400,550,400                                            TRER2
  400 T=A(L1,ICOL)                                                       TRER2
      A(L1,ICOL)=0.0                                                     TRER2
      DO 450 L=1,N                                                       TRER2
  450 A(L1,L)=A(L1,L)-A(ICOL,L)*T                                        TRER2
      IF(M) 550,550,460                                                  TRER2
  460 DO 500 L=1,M                                                       TRER2
  500 B(L1,L)=B(L1,L)-B(ICOL,L)*T                                        TRER2
  550 CONTINUE                                                           TRER2
      DO 710 I=1,N                                                       TRER2
      L=N+1-I                                                            TRER2
      IF(INDEX(L,1)-INDEX(L,2)) 630,710,630                              TRER2
  630 JROW=INDEX(L,1)                                                    TRER2
      JCOL=INDEX(L,2)                                                    TRER2
      DO 705 K=1,N                                                       TRER2
      SWAP=A(K,JROW)                                                     TRER2
      A(K,JROW)=A(K,JCOL)                                                TRER2
      A(K,JCOL)=SWAP                                                     TRER2
  705 CONTINUE                                                           TRER2
  710 CONTINUE                                                           TRER2
  740 RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE PW55(T2,IQE,IHT,IKT,ILT,NTOT,ISYM,A,B,IEKV)             TRER2
C     BILDA NORMALEKV. MATRISERNA A OCH B. ORIML.PROBLEM GER IEKV=0      TRER2
      DIMENSION T2(1), IQE(1),IHT(1),IKT(1),ILT(1),A(6,6),B(6,1)         TRER2
      DO 7 I=1,6                                                         TRER2
      DO 7 J=1,6                                                         TRER2
    7 A(I,J)=0.0                                                         TRER2
      DO 8 I=1,6                                                         TRER2
    8 B(I,1)=0.0                                                         TRER2
      IEKV=0                                                             TRER2
      GO TO(1,2,3,4,3,3),ISYM                                            TRER2
    1 DO 9 I=1,NTOT                                                      TRER2
      IF(IQE(I))10,9,10                                                  TRER2
   10 U1=FLOAT(IHT(I)**2+IKT(I)**2+ILT(I)**2)                            TRER2
      A(1,1)=U1**2+A(1,1)                                                TRER2
      B(1,1)=U1*T2(I)+B(1,1)                                             TRER2
      IEKV=IEKV+1                                                        TRER2
    9 CONTINUE                                                           TRER2
      IF(IEKV-1)11,11,12                                                 TRER2
   11 IEKV=0                                                             TRER2
      GO TO 12                                                           TRER2
    2 DO 13 I=1,NTOT                                                     TRER2
      IF(IQE(I)) 14,13,14                                                TRER2
   14 U1=FLOAT(IHT(I)**2+IKT(I)**2)                                      TRER2
      A(1,1)=U1**2+A(1,1)                                                TRER2
      A(1,2)=FLOAT(ILT(I)**2)*U1+A(1,2)                                  TRER2
      A(2,2)=FLOAT(ILT(I))**4+A(2,2)                                     TRER2
      B(1,1)=U1*T2(I)+B(1,1)                                             TRER2
      B(2,1)=FLOAT(ILT(I)**2)*T2(I)+B(2,1)                               TRER2
      IEKV=IEKV+1                                                        TRER2
   13 CONTINUE                                                           TRER2
   16 IF(IEKV-2) 11,11,15                                                TRER2
   15 A(2,1)=A(1,2)                                                      TRER2
      GO TO 12                                                           TRER2
    4 DO 17 I=1,NTOT                                                     TRER2
      IF(IQE(I))18,17,18                                                 TRER2
   18 U1=FLOAT(IHT(I)**2+IHT(I)*IKT(I)+IKT(I)**2)                        TRER2
      A(1,1)=U1**2+A(1,1)                                                TRER2
      A(1,2)=U1*FLOAT(ILT(I)**2)+A(1,2)                                  TRER2
      A(2,2)=FLOAT(ILT(I))**4+A(2,2)                                     TRER2
      B(1,1)=U1*T2(I)+B(1,1)                                             TRER2
      B(2,1)=FLOAT(ILT(I)**2)*T2(I)+B(2,1)                               TRER2
      IEKV=IEKV+1                                                        TRER2
   17 CONTINUE                                                           TRER2
      GO TO 16                                                           TRER2
    3 DO 19 I=1,NTOT                                                     TRER2
      IF(IQE(I)) 20,19,20                                                TRER2
   20 U1=FLOAT(IHT(I)**2)                                                TRER2
      U2=FLOAT(IKT(I)**2)                                                TRER2
      U3=FLOAT(ILT(I)**2)                                                TRER2
      A(1,1)=U1**2+A(1,1)                                                TRER2
      A(1,2)=U1*U2+A(1,2)                                                TRER2
      A(1,3)=U1*U3+A(1,3)                                                TRER2
      B(1,1)=U1*T2(I)+B(1,1)                                             TRER2
      B(2,1)=U2*T2(I)+B(2,1)                                             TRER2
      B(3,1)=U3*T2(I)+B(3,1)                                             TRER2
      A(2,2)=U2**2+A(2,2)                                                TRER2
      A(2,3)=U2*U3+A(2,3)                                                TRER2
      A(3,3)=U3**2+A(3,3)                                                TRER2
      IEKV=IEKV+1                                                        TRER2
      GO TO(11,11,19,11,21,21),ISYM                                      TRER2
   21 U4=FLOAT(IHT(I)*ILT(I))                                            TRER2
      A(1,4)=U1*U4+A(1,4)                                                TRER2
      A(2,4)=U2*U4+A(2,4)                                                TRER2
      A(3,4)=U3*U4+A(3,4)                                                TRER2
      A(4,4)=U4**2+A(4,4)                                                TRER2
      B(4,1)=U4*T2(I)+B(4,1)                                             TRER2
      GO TO(11,11,11,11,19,22),ISYM                                      TRER2
   22 U5=FLOAT(IHT(I)*IKT(I))                                            TRER2
      U6=FLOAT(IKT(I)*ILT(I))                                            TRER2
      A(1,5)=U1*U5+A(1,5)                                                TRER2
      A(1,6)=U1*U6+A(1,6)                                                TRER2
      A(2,5)=U2*U5+A(2,5)                                                TRER2
      A(2,6)=U2*U6+A(2,6)                                                TRER2
      A(3,5)=U3*U5+A(3,5)                                                TRER2
      A(3,6)=U3*U6+A(3,6)                                                TRER2
      A(4,5)=U4*U5+A(4,5)                                                TRER2
      A(4,6)=U4*U6+A(4,6)                                                TRER2
      A(5,5)=U5**2+A(5,5)                                                TRER2
      A(5,6)=U5*U6+A(5,6)                                                TRER2
      A(6,6)=U6**2+A(6,6)                                                TRER2
      B(5,1)=U5*T2(I)+B(5,1)                                             TRER2
      B(6,1)=U6*T2(I)+B(6,1)                                             TRER2
   19 CONTINUE                                                           TRER2
      A(2,1)=A(1,2)                                                      TRER2
      A(3,1)=A(1,3)                                                      TRER2
      A(3,2)=A(2,3)                                                      TRER2
      GO TO(11,11,23,11,24,24),ISYM                                      TRER2
   23 IF(IEKV-3)11,11,12                                                 TRER2
   24 A(4,1)=A(1,4)                                                      TRER2
      A(4,2)=A(2,4)                                                      TRER2
      A(4,3)=A(3,4)                                                      TRER2
      GO TO(11,11,11,11,25,26),ISYM                                      TRER2
   25 IF(IEKV-4)11,11,12                                                 TRER2
   26 A(5,1)=A(1,5)                                                      TRER2
      A(5,2)=A(2,5)                                                      TRER2
      A(5,3)=A(3,5)                                                      TRER2
      A(5,4)=A(4,5)                                                      TRER2
      A(6,1)=A(1,6)                                                      TRER2
      A(6,2)=A(2,6)                                                      TRER2
      A(6,3)=A(3,6)                                                      TRER2
      A(6,4)=A(4,6)                                                      TRER2
      A(6,5)=A(5,6)                                                      TRER2
      IF(IEKV-6)11,11,12                                                 TRER2
   12 RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE PW56(T1,T2,IHT,IKT,ILT,N1,N2,IOUT,D1,SSQTL,D2,WAVE,TUT, TRER2
     1N20,NTWTY,SQTY,M20,NOIND)                                          TRER2
      DIMENSION T1(1),T2(1),IHT(1),IKT(1),ILT(1),TUT(1)                  TRER2
C     SORTERING OCH TRYCKNING AV SSQT-OBS OCH -CALC MED H,K,L            TRER2
      NOIND=0                                                            TRER2
      NWIND=0                                                            TRER2
      DO 1 J1=1,N2                                                       TRER2
      ISH=IHT(J1)                                                        TRER2
      ISK=IKT(J1)                                                        TRER2
      ISL=ILT(J1)                                                        TRER2
      TS=T2(J1)                                                          TRER2
      IMH=ISH                                                            TRER2
      IMK=ISK                                                            TRER2
      IML=ISL                                                            TRER2
      TM=TS                                                              TRER2
      DO 2 J2=J1,N2                                                      TRER2
      IF(TM-T2(J2)) 2,3,3                                                TRER2
    3 TM=T2(J2)                                                          TRER2
      IMH=IHT(J2)                                                        TRER2
      IMK=IKT(J2)                                                        TRER2
      IML=ILT(J2)                                                        TRER2
      J3=J2                                                              TRER2
    2 CONTINUE                                                           TRER2
      IHT(J1)=IMH                                                        TRER2
      IKT(J1)=IMK                                                        TRER2
      ILT(J1)=IML                                                        TRER2
      T2(J1)=TM                                                          TRER2
      IHT(J3)=ISH                                                        TRER2
      IKT(J3)=ISK                                                        TRER2
      ILT(J3)=ISL                                                        TRER2
    1 T2(J3)=TS                                                          TRER2
      DSUM=0.0                                                           TRER2
      NTAL=0                                                             TRER2
      WRITE(IOUT,4)                                                      TRER2
    4 FORMAT(///1X,59H  H  K  L   OBS       CALC      DELTA     DOBS A   TRER2
     1  DCALC A)                                                         TRER2
      J=1                                                                TRER2
      DO 17 I=1,N2                                                       TRER2
    5 IF(J-N1) 6,6,15                                                    TRER2
    6 IF(I-N2) 7,8,8                                                     TRER2
    7 IF(ABS(T1(J)-T2(I))-ABS(T1(J)-T2(I+1))) 8,8,15                     TRER2
    8 IF(T1(J)-SSQTL) 9,9,10                                             TRER2
    9 IF(ABS(T1(J)-T2(I))-D1) 13,13,11                                   TRER2
   10 IF(ABS(T1(J)-T2(I))-D2) 13,13,11                                   TRER2
   11 IF(T1(J)-T2(I)) 12,12,15                                           TRER2
   12 DOBS=WAVE/(2.*SQRT(T1(J)))                                         TRER2
      WRITE(IOUT,20) T1(J),DOBS,TUT(J)                                   TRER2
      NOIND=NOIND+1                                                      TRER2
      IF(T1(J)-SQTY) 51,51,52                                            TRER2
   51 NWIND=NWIND+1                                                      TRER2
   52 J=J+1                                                              TRER2
      GO TO 5                                                            TRER2
   13 DOBS=WAVE/(2.*SQRT(T1(J)))                                         TRER2
      DCALC=WAVE/(2.*SQRT(T2(I)))                                        TRER2
      DELTA=T1(J)-T2(I)                                                  TRER2
      WRITE(IOUT,14) IHT(I),IKT(I),ILT(I),T1(J),T2(I),DELTA,DOBS,DCALC,T TRER2
     1UT(J)                                                              TRER2
   14 FORMAT(1X,3I3,F9.6,2F10.6,2F10.5,5X,A4)                            TRER2
      IF(SQTY-T1(J)) 42,40,40                                            TRER2
   40 DSUM=DSUM+ABS(DELTA)                                               TRER2
      NTAL=NTAL+1                                                        TRER2
   42 J=J+1                                                              TRER2
      GO TO 17                                                           TRER2
   15 DCALC=WAVE/(2.*SQRT(T2(I)))                                        TRER2
      WRITE(IOUT,16) IHT(I),IKT(I),ILT(I),T2(I),DCALC                    TRER2
   16 FORMAT(1X,3I3,9X,F10.6,20X,F10.5)                                  TRER2
   17 CONTINUE                                                           TRER2
   18 IF(J-N1) 19,19,21                                                  TRER2
   19 DOBS=WAVE/(2.*SQRT(T1(J)))                                         TRER2
      WRITE(IOUT,20) T1(J),DOBS,TUT(J)                                   TRER2
   20 FORMAT(10X,F9.6,20X,F10.5,15X,A4)                                  TRER2
      NOIND=NOIND+1                                                      TRER2
      IF(T1(J)-SQTY) 61,61,62                                            TRER2
   61 NWIND=NWIND+1                                                      TRER2
   62 J=J+1                                                              TRER2
      GO TO 18                                                           TRER2
   21 WRITE(IOUT,22) N1                                                  TRER2
   22 FORMAT(///21H NUMBER OF OBS SSQT =,I10)                            TRER2
      WRITE(IOUT,23) N2                                                  TRER2
   23 FORMAT(22H NUMBER OF CALC SSQT =,I10)                              TRER2
      VMED=DSUM/NTAL                                                     TRER2
      HNM20=2.0*VMED*N20                                                 TRER2
      IF(HNM20) 38,38,43                                                 TRER2
   43 M20=SQTY/HNM20+0.5                                                 TRER2
      WRITE(IOUT,44) NTWTY,M20,N20,VMED,SQTY                             TRER2
   44 FORMAT(31H FIGURE OF MERIT CALC. FROM THE,I3,26H FIRST SINE SQUARE TRER2
     1 THETAS=,I5,/,24H NUMBER OF THEOR. LINES=,I5,6H VMED=,F10.7,/,25H  TRER2
     2SINE SQUARE THETA LIMIT=,F10.6)                                    TRER2
   38 WRITE(IOUT,46) NOIND                                               TRER2
   46 FORMAT(40H NUMBER OF UNINDEXED SINE SQUARE THETAS=,I4)             TRER2
      NOIND=NWIND                                                        TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE PW62(A,B,C,BE,S,ISYM)                                   TRER2
C     PARTIAL DERIVATIVES OF DIRECT LATTICE PARAMETERS(NOT TRICLINIC)    TRER2
      DIMENSION S(6,6)                                                   TRER2
      GO TO(1,2,3,4,5),ISYM                                              TRER2
    5 S(1,1)=-0.5*A*A*A                                                  TRER2
      S(1,2)=0.0                                                         TRER2
      S(1,3)=-0.5*A*C*C*COS(BE)**2                                       TRER2
      S(1,4)=-0.5*A*A*C*COS(BE)                                          TRER2
      S(2,1)=0.0                                                         TRER2
      S(2,2)=-0.5*B*B*B                                                  TRER2
      S(2,3)=0.0                                                         TRER2
      S(2,4)=0.0                                                         TRER2
      S(3,1)=-0.5*A*A*C*COS(BE)**2                                       TRER2
      S(3,2)=0.0                                                         TRER2
      S(3,3)=-0.5*C*C*C                                                  TRER2
      S(3,4)=-0.5*A*C*C*COS(BE)                                          TRER2
      S(4,1)=0.25*A*A*SIN(2.*BE)                                         TRER2
      S(4,2)=0.0                                                         TRER2
      S(4,3)=0.25*C*C*SIN(2.*BE)                                         TRER2
      S(4,4)=0.5*A*C*SIN(BE)                                             TRER2
      RETURN                                                             TRER2
    4 S(1,1)=-(3.*A*A*A)/8.                                              TRER2
    6 S(1,2)=0.0                                                         TRER2
      S(2,1)=0.0                                                         TRER2
      S(2,2)=-0.5*C*C*C                                                  TRER2
      RETURN                                                             TRER2
    3 S(1,1)=-0.5*A*A*A                                                  TRER2
      S(1,2)=0.0                                                         TRER2
      S(1,3)=0.0                                                         TRER2
      S(2,1)=0.0                                                         TRER2
      S(2,2)=-0.5*B*B*B                                                  TRER2
      S(2,3)=0.0                                                         TRER2
      S(3,1)=0.0                                                         TRER2
      S(3,2)=0.0                                                         TRER2
      S(3,3)=-0.5*C*C*C                                                  TRER2
      RETURN                                                             TRER2
    2 S(1,1)=-0.5*A*A*A                                                  TRER2
      GO TO 6                                                            TRER2
    1 S(1,1)=-0.5*A*A*A                                                  TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE PW63(A11,A22,A33,A13,A12,A23,WAVE,ISYM,A,B,C,AL,BE,GA)  TRER2
C     CALC. OF DIRECT LATTICE PARAMETERS                                 TRER2
C                                                                        TRER2
      GO TO(1,2,3,4,5,6),ISYM                                            TRER2
    1 A=WAVE/(2.*SQRT(A11))                                              TRER2
      RETURN                                                             TRER2
    2 C=WAVE/(2.*SQRT(A22))                                              TRER2
      GO TO 1                                                            TRER2
    3 B=WAVE/(2.*SQRT(A22))                                              TRER2
      C=WAVE/(2.*SQRT(A33))                                              TRER2
      GO TO 1                                                            TRER2
    4 A=WAVE/SQRT(3.*A11)                                                TRER2
      C=WAVE/(2.*SQRT(A22))                                              TRER2
      RETURN                                                             TRER2
    5 CBST=A13/(2.*SQRT(A11*A33))                                        TRER2
      SBST=SQRT(1.-CBST*CBST)                                            TRER2
      IF(CBST-0.0005) 7,8,8                                              TRER2
    7 BE=1.570796                                                        TRER2
      GO TO 9                                                            TRER2
    8 TBST=SBST/CBST                                                     TRER2
      BST=ATAN(TBST)                                                     TRER2
      BE=3.141593-BST                                                    TRER2
    9 A=WAVE/(2.*SBST*SQRT(A11))                                         TRER2
      B=WAVE/(2.*SQRT(A22))                                              TRER2
      C=WAVE/(2.*SBST*SQRT(A33))                                         TRER2
      RETURN                                                             TRER2
    6 S=4./(WAVE*WAVE)                                                   TRER2
      AST=SQRT(A11*S)                                                    TRER2
      BST=SQRT(A22*S)                                                    TRER2
      CST=SQRT(A33*S)                                                    TRER2
      CAST=A23/(2.*SQRT(A22*A33))                                        TRER2
      CBST=A13/(2.*SQRT(A11*A33))                                        TRER2
      CGST=A12/(2.*SQRT(A11*A22))                                        TRER2
      VST=AST*BST*CST*SQRT(1.-CAST**2-CBST**2-CGST**2+2.*CAST*CBST*CGST) TRER2
      SAST=SQRT(1.-CAST**2)                                              TRER2
      SBST=SQRT(1.-CBST**2)                                              TRER2
      SGST=SQRT(1.-CGST**2)                                              TRER2
      CAL=(CBST*CGST-CAST)/(SBST*SGST)                                   TRER2
      CBE=(CAST*CGST-CBST)/(SAST*SGST)                                   TRER2
      CGA=(CAST*CBST-CGST)/(SAST*SBST)                                   TRER2
      IF(ABS(CAL)-0.0005) 10,11,11                                       TRER2
   10 AL=1.570796                                                        TRER2
      GO TO 12                                                           TRER2
   11 SAL=SQRT(1.-CAL**2)                                                TRER2
      AL=ATAN(SAL/CAL)                                                   TRER2
   12 IF(ABS(CBE)-0.0005) 13,14,14                                       TRER2
   13 BE=1.570796                                                        TRER2
      GO TO 15                                                           TRER2
   14 SBE=SQRT(1.-CBE**2)                                                TRER2
      BE=ATAN(SBE/CBE)                                                   TRER2
   15 IF(ABS(CGA)-0.0005) 16,17,17                                       TRER2
   16 GA=1.570796                                                        TRER2
      GO TO 18                                                           TRER2
   17 SGA=SQRT(1.-CGA**2)                                                TRER2
      GA=ATAN(SGA/CGA)                                                   TRER2
   18 A=(BST*CST*SAST)/VST                                               TRER2
      B=(AST*CST*SBST)/VST                                               TRER2
      C=(AST*BST*SGST)/VST                                               TRER2
      RETURN                                                             TRER2
      END                                                                TRER2
      SUBROUTINE TREOD                                                   TRER2
      DIMENSION         T2(270),IHT(270),IKT(270),ILT(270),IQE(270),AMAT TRER2
     1(6,6),BMAT(6,1),DET(6,6),S(6,6),F(6)                               TRER2
      COMMON DEN,EDEN,RMOLV                                              TRER2
      COMMON T1(100),TAGUT(100),N1,D1,SSQTL,D2,WAVE,IHM,IKM,ILM,ISYM,INR TRER2
     1,ISUB,A11,A22,A33,A13,A12,A23,LIN(10),REV(10)                      TRER2
     2,IGOT,IS1,IS2,IS3,IS4,IA,IB,IQ,IH1,IK1,IL1,IH2,IK2,IL2,IH3,IK3,IL3 TRER2
     3,SQ1,SQ2,SQ3,X,Y,Z,IC(20),ISQM,KOTA(30),RO(4,30),ID,IIN,IOUT       TRER2
      COMMON NH1,NK1,NL1,NS1,NH2,NK2,NL2,NS2,NH3,NK3,NL3,NS3,IUTSK,IMER, TRER2
     1INIX,IOMIT,ISC,KLART,VOL,VTEST,XL,YL,IT20,IT40                     TRER2
     2,IFRED(40)                                                         TRER2
      TRIAL=0.00015                                                      TRER2
      RKON=2.0/3.0                                                       TRER2
    7 FORMAT(6F10.6)                                                     TRER2
 2000 WRITE(IOUT,8)                                                      TRER2
    8 FORMAT(///,14H CYCLE RESULTS,//)                                   TRER2
      IV=INR                                                             TRER2
      IDIR=INR                                                           TRER2
      IHM=0                                                              TRER2
      IKM=0                                                              TRER2
      ILM=0                                                              TRER2
      SSQTM=T1(N1)+2*D2                                                  TRER2
   76 IHM=IHM+1                                                          TRER2
      IF(SSQTM-IHM*IHM*A11)77,76,76                                      TRER2
   77 IHM=IHM-1                                                          TRER2
      GO TO(101,102,78,102,78,78),ISYM                                   TRER2
  101 IKM=IHM                                                            TRER2
      ILM=IHM                                                            TRER2
      GO TO 81                                                           TRER2
  102 IKM=IHM                                                            TRER2
  103 ILM=ILM+1                                                          TRER2
      IF(SSQTM-ILM*ILM*A22)81,103,103                                    TRER2
   78 IKM=IKM+1                                                          TRER2
      IF(SSQTM-IKM*IKM*A22)79,78,78                                      TRER2
   79 IKM=IKM-1                                                          TRER2
   80 ILM=ILM+1                                                          TRER2
      IF(SSQTM-ILM*ILM*A33)81,80,80                                      TRER2
   81 IF(N1-20)304,305,305                                               TRER2
  304 NTWTY=N1                                                           TRER2
      GO TO 306                                                          TRER2
  305 NTWTY=20                                                           TRER2
  306 SQTY=T1(NTWTY)                                                     TRER2
  200 N2=0                                                               TRER2
      IH=0                                                               TRER2
      IK=0                                                               TRER2
      IL=0                                                               TRER2
      N20=0                                                              TRER2
  300 CALL PW50(A11,A22,A33,A13,A12,A23,ISYM,IHM,IKM,ILM,IH,IK,IL,SSQT,I TRER2
     1A)                                                                 TRER2
      IF(IA) 301,600,301                                                 TRER2
  301 IF(SSQT-SSQTM) 303,303,300                                         TRER2
  303 IF(ISUB) 302,400,302                                               TRER2
  302 CALL EX(IH,IK,IL,IJ)                                               TRER2
      IF(IJ) 400,300,400                                                 TRER2
  400 CALL PW51(SSQT,T1,N1,SSQTL,D1,D2,SSQTO,IA)                         TRER2
      IF(SSQT-SQTY) 307,307,308                                          TRER2
  307 N20=N20+1                                                          TRER2
  308 IF(IA) 401,300,401                                                 TRER2
  401 IF(INR) 500,402,500                                                TRER2
  402 CALL PW53(SSQT,T2,N2,IHT,IKT,ILT,IQE,IH,IK,IL,ISYM)                TRER2
      IF(SSQT) 403,300,300                                               TRER2
  403 N2=N2+1                                                            TRER2
      IF(N2-300) 300,900,900                                             TRER2
  500 CALL PW53(SSQTO,T2,N2,IHT,IKT,ILT,IQE,IH,IK,IL,ISYM)               TRER2
      IF(SSQTO) 501,300,300                                              TRER2
  501 N2=N2+1                                                            TRER2
      IF(N2-270) 300,600,600                                             TRER2
  600 IF(INR) 601,900,601                                                TRER2
  601 IF(IV) 602,603,602                                                 TRER2
  602 IV=IV-1                                                            TRER2
      GO TO 700                                                          TRER2
  603 CALL PW71(T2,IHT,IKT,ILT,IQE,ISYM,N2,A11,A22,A33,A13,A12,A23,V2,NE TRER2
     1KV)                                                                TRER2
      INR=0                                                              TRER2
      CALL PW63(A11,A22,A33,A13,A12,A23,WAVE,ISYM,A,B,C,AL,BE,GA)        TRER2
      CALL PW62(A,B,C,BE,S,ISYM)                                         TRER2
      SIG=SQRT(V2/(NEKV-N))                                              TRER2
      SIG=(4.0*SIG)/(WAVE*WAVE)                                          TRER2
      DO 612 L=1,N                                                       TRER2
      F(L)=0.                                                            TRER2
      DO 613 J=1,N                                                       TRER2
      DO 613 K=1,N                                                       TRER2
  613 F(L)=F(L)+AMAT(J,K)*S(L,J)*S(L,K)                                  TRER2
  612 F(L)=SIG*SQRT(F(L))                                                TRER2
      GO TO(620,620,622,620,622,622),ISYM                                TRER2
  620 WRITE(IOUT,630) A,F(1)                                             TRER2
  630 FORMAT(7H     A=,2F10.6,2H A)                                      TRER2
      IF(1-ISYM) 621,640,640                                             TRER2
  621 WRITE(IOUT,631) C,F(2)                                             TRER2
  631 FORMAT(7H     C=,2F10.6,2H A)                                      TRER2
      GO TO 640                                                          TRER2
  622 WRITE(IOUT,632) A,F(1),B,F(2),C,F(3)                               TRER2
  632 FORMAT(7H     A=,2F10.6,2H A,/,7H     B=,2F10.6,2H A,/,7H     C=,2 TRER2
     1F10.6,2H A)                                                        TRER2
      IF(5-ISYM) 624,623,640                                             TRER2
  623 BE=BE*57.2958                                                      TRER2
      DBE=F(4)*57.2958                                                   TRER2
      WRITE(IOUT,633) BE,DBE                                             TRER2
  633 FORMAT(7H  BETA=,2F10.6,4H DEG)                                    TRER2
      GO TO 640                                                          TRER2
  624 AL=AL*57.2958                                                      TRER2
      IF(AL)650,651,651                                                  TRER2
  650 AL=180.+AL                                                         TRER2
  651 DAL=F(4)*57.2958                                                   TRER2
      BE=BE*57.2958                                                      TRER2
      IF(BE) 652,653,653                                                 TRER2
  652 BE=180.+BE                                                         TRER2
  653 DBE=F(5)*57.2958                                                   TRER2
      GA=GA*57.2958                                                      TRER2
      IF(GA) 654,655,655                                                 TRER2
  654 GA=180.+GA                                                         TRER2
  655 DGA=F(6)*57.2958                                                   TRER2
      WRITE(IOUT,634) AL,DAL,BE,DBE,GA,DGA                               TRER-2
  634 FORMAT(7H  ALFA=,2F10.6,4H DEG,/,7H  BETA=,2F10.6,4H DEG,/,7H GAMM TRER-2
     1A=,2F10.6,4H DEG)                                                  TRER-2
  640 WRITE(IOUT,641) NEKV,N1                                            TRER-2
  641 FORMAT(//,32H NUMBER OF SINGLE INDEXED LINES=,I5,23H TOTAL NUMBER  TRER-2
     1OF LINES=,I5)                                                      TRER-2
      GO TO 200                                                          TRER-2
  700 CALL PW55(T2,IQE,IHT,IKT,ILT,N2,ISYM,AMAT,BMAT,IEKV)               TRER-2
      IF(IEKV) 800,701,800                                               TRER-2
  701 WRITE(IOUT,702)                                                    TRER-2
  702 FORMAT(44H NUMBER OF EQ LESS THAN NUMBER OF PARAMETERS)            TRER-2
      INR=0                                                              TRER-2
      GO TO 200                                                          TRER2
  800 N=1                                                                TRER2
      GO TO (801,802,803,802,804,805),ISYM                               TRER2
  805 N=N+2                                                              TRER2
  804 N=N+1                                                              TRER2
  803 N=N+1                                                              TRER2
  802 N=N+1                                                              TRER2
  801 CALL PW54(AMAT,N,BMAT,1,DET)                                       TRER2
      IF(ABS(A11-BMAT(1,1))-0.001) 910,910,912                           TRER2
  910 IF(ABS(A22-BMAT(2,1))-0.001) 911,911,912                           TRER2
  912 INR=0                                                              TRER2
      GO TO 200                                                          TRER2
  911 A11=BMAT(1,1)                                                      TRER2
      A22=BMAT(2,1)                                                      TRER2
      A33=BMAT(3,1)                                                      TRER2
      A13=BMAT(4,1)                                                      TRER2
      A12=BMAT(5,1)                                                      TRER2
      A23=BMAT(6,1)                                                      TRER2
      WRITE(IOUT,7) A11,A22,A33,A13,A12,A23                              TRER2
      GO TO 200                                                          TRER2
  900 CALL PW56(T1,T2,IHT,IKT,ILT,N1,N2,IOUT,D1,SSQTL,D2,WAVE,TAGUT,N20, TRER2
     1NTWTY,SQTY,M20,NOIND)                                              TRER2
      IF(ISYM-3) 1026,1030,1026                                          TRER2
 1030 IF(ABS(A11-A22)-TRIAL) 1001,1001,1002                              TRER2
 1001 IF(ABS(A11-A33)-TRIAL) 1003,1003,1004                              TRER2
 1003 A11=(A11+A22+A33)/3.0                                              TRER2
      WRITE(IOUT,1005)                                                   TRER2
 1005 FORMAT(23H TEST OF CUBIC SYMMETRY)                                 TRER2
      A22=0.0                                                            TRER2
      A33=0.0                                                            TRER2
      ISYM=1                                                             TRER2
 1007 INR=3                                                              TRER2
      GO TO 2000                                                         TRER2
 1004 A11=(A11+A22)/2.0                                                  TRER2
      A22=A33                                                            TRER2
 1010 A33=0.0                                                            TRER2
      ISYM=2                                                             TRER2
      WRITE(IOUT,1006)                                                   TRER2
 1006 FORMAT(28H TEST OF TETRAGONAL SYMMETRY)                            TRER2
      GO TO 1007                                                         TRER2
 1002 IF(ABS(A11-A33)-TRIAL) 1008,1008,1009                              TRER2
 1008 A11=(A11+A33)/2.0                                                  TRER2
      GO TO 1010                                                         TRER2
 1009 IF(ABS(A22-A33)-TRIAL) 1011,1011,1012                              TRER2
 1011 HA22=A11                                                           TRER2
      A11=(A22+A33)/2.0                                                  TRER2
      A22=HA22                                                           TRER2
      GO TO 1010                                                         TRER2
 1012 IF(ABS(A11-3.0*A22)-TRIAL) 1013,1013,1014                          TRER2
 1013 A11=(A11+3.0*A22)*RKON                                             TRER2
 1018 A22=A33                                                            TRER2
 1020 A33=0.0                                                            TRER2
      ISYM=4                                                             TRER2
      WRITE(IOUT,1015)                                                   TRER2
 1015 FORMAT(27H TEST OF HEXAGONAL SYMMETRY)                             TRER2
      GO TO 1007                                                         TRER2
 1014 IF(ABS(A22-3.0*A11)-TRIAL) 1016,1016,1017                          TRER2
 1016 A11=(A22+3.0*A11)*RKON                                             TRER2
      GO TO 1018                                                         TRER2
 1017 IF(ABS(A11-3.0*A33)-TRIAL) 1027,1027,1019                          TRER2
 1027 A11=(A11+3.0*A33)*RKON                                             TRER2
      GO TO 1020                                                         TRER2
 1019 IF(ABS(A33-3.0*A11)-TRIAL) 1021,1021,1022                          TRER2
 1021 A11=(A33+3.0*A11)*RKON                                             TRER2
      GO TO 1020                                                         TRER2
 1022 IF(ABS(A22-3.0*A33)-TRIAL) 1023,1023,1024                          TRER2
 1023 HA22=A11                                                           TRER2
      A11=(A22+3.0*A33)*RKON                                             TRER2
      A22=HA22                                                           TRER2
      GO TO 1020                                                         TRER2
 1024 IF(ABS(A33-3.0*A22)-TRIAL) 1025,1025,1026                          TRER2
 1025 HA22=A11                                                           TRER2
      A11=(A33+3.0*A22)*RKON                                             TRER2
      A22=HA22                                                           TRER2
      GO TO 1020                                                         TRER2
 1026 IF(M20-IMER) 1100,1101,1101                                        TRER2
 1101 IF(NOIND-INIX) 1102,1102,1100                                      TRER2
 1102 WRITE(IOUT,1103)                                                   TRER2
 1103 FORMAT(59H CHECK IF THERE IS ANY COMMON FACTOR IN THE QUADRATIC FO TRER2
     1RMS,/,69H CHECK CONVERGENCE IN THE REFINEMENT (EV. USE PROGRAM PIR TRER2
     2UM OR PURUM),/,20H END OF CALCULATIONS)                            TRER2
      STOP                                                               TRER2
 1100 RETURN                                                             TRER2
      END                                                                TRER2
                                                                         TRER2
 
 
 
 
